Theory ListAux
section ‹Basic Functions Old and New›
theory ListAux
imports Main
begin
declare Let_def[simp]
subsection ‹HOL›
lemma pairD: "(a,b) = p ⟹ a = fst p ∧ b = snd p"
by auto
lemmas conj_aci = conj_comms conj_assoc conj_absorb conj_left_absorb
definition enum :: "nat ⇒ nat set" where
[code_abbrev]: "enum n = {..<n}"
lemma [code]:
"enum 0 = {}"
"enum (Suc n) = insert n (enum n)"
unfolding enum_def lessThan_0 lessThan_Suc by rule+
subsection ‹Lists›
declare List.member_def[simp] list_all_iff[simp] list_ex_iff[simp]
subsubsection‹‹length››
notation length ("|_|")
lemma length3D: "|xs| = 3 ⟹ ∃x y z. xs = [x, y, z]"
apply (cases xs) apply simp
apply (case_tac list) apply simp
apply (case_tac lista) by simp_all
lemma length4D: "|xs| = 4 ⟹ ∃ a b c d. xs = [a, b, c, d]"
apply (case_tac xs) apply simp
apply (case_tac list) apply simp
apply (case_tac lista) apply simp
apply (case_tac listb) by simp_all
subsubsection ‹@{const filter}›
lemma filter_emptyE[dest]: "(filter P xs = []) ⟹ x ∈ set xs ⟹ ¬ P x"
by (simp add: filter_empty_conv)
lemma filter_comm: "[x ← xs. P x ∧ Q x] = [x ← xs. Q x ∧ P x]"
by (simp add: conj_aci)
lemma filter_prop: "x ∈ set [u←ys . P u] ⟹ P x"
proof (induct ys arbitrary: x)
case Nil then show ?case by simp
next
case Cons then show ?case by (auto split: if_split_asm)
qed
lemma filter_compl1:
"([x←xs. P x] = []) = ([x←xs. ¬ P x] = xs)" (is "?lhs = ?rhs")
proof
show "?rhs ⟹ ?lhs"
proof (induct xs)
case Nil then show ?case by simp
next
case (Cons x xs)
have "[u←xs . ¬ P u] ≠ x # xs"
proof
assume "[u←xs . ¬ P u] = x # xs"
then have "|x # xs| = |[u←xs . ¬ P u]|" by simp
also have "... ≤ |xs|" by simp
finally show False by simp
qed
with Cons show ?case by auto
qed
next
show "?lhs ⟹ ?rhs"
by (induct xs) (simp_all split: if_split_asm)
qed
lemma [simp]: "Not ∘ (Not ∘ P) = P"
by (rule ext) simp
lemma filter_eqI:
"(⋀v. v ∈ set vs ⟹ P v = Q v) ⟹ [v←vs . P v] = [v←vs . Q v]"
by (induct vs) simp_all
lemma filter_simp: "(⋀x. x ∈ set xs ⟹ P x) ⟹ [x←xs. P x ∧ Q x] = [x←xs. Q x]"
by (induct xs) auto
lemma filter_True_eq1:
"(length [y←xs. P y] = length xs) ⟹ (⋀y. y ∈ set xs ⟹ P y)"
proof (induct xs)
case Nil then show ?case by simp
next
case (Cons x xs)
have l: "length (filter P xs) ≤ length xs"
by (simp add: length_filter_le)
have hyp: "length (filter P (x # xs)) = length (x # xs)" by fact
then have "P x" by (simp split: if_split_asm) (insert l, arith)
moreover with hyp have "length (filter P xs) = length xs"
by (simp split: if_split_asm)
moreover have "y ∈ set (x#xs)" by fact
ultimately show ?case by (auto dest: Cons(1))
qed
lemma [simp]: "[f x. x <- xs, P x] = [f x. x <- [x ← xs. P x]]"
by (induct xs) auto
subsubsection ‹@{const concat}›
syntax
"_concat" :: "idt ⇒ 'a list ⇒ 'a list ⇒ 'a list" ("⨆⇘_∈ _⇙ _" 10)
translations
"⨆⇘x∈xs⇙ f" == "CONST concat [f. x <- xs]"
subsubsection ‹List product›
definition listProd1 :: "'a ⇒ 'b list ⇒ ('a × 'b) list" where
"listProd1 a bs ≡ [(a,b). b <- bs]"
definition listProd :: "'a list ⇒ 'b list ⇒ ('a × 'b) list" (infix "×" 50) where
"as × bs ≡ ⨆⇘a ∈ as⇙ listProd1 a bs"
lemma[simp]: "set (xs × ys) = (set xs) × (set ys)"
by (auto simp: listProd_def listProd1_def)
subsubsection ‹Minimum and maximum›
primrec minimal:: "('a ⇒ nat) ⇒ 'a list ⇒ 'a" where
"minimal m (x#xs) =
(if xs=[] then x else
let mxs = minimal m xs in
if m x ≤ m mxs then x else mxs)"
lemma minimal_in_set[simp]: "xs ≠ [] ⟹ minimal f xs : set xs"
by(induct xs) auto
primrec min_list :: "nat list ⇒ nat" where
"min_list (x#xs) = (if xs=[] then x else min x (min_list xs))"
primrec max_list :: "nat list ⇒ nat" where
"max_list (x#xs) = (if xs=[] then x else max x (max_list xs))"
lemma min_list_conv_Min[simp]:
"xs ≠ [] ⟹ min_list xs = Min (set xs)"
by (induct xs) auto
lemma max_list_conv_Max[simp]:
"xs ≠ [] ⟹ max_list xs = Max (set xs)"
by (induct xs) auto
subsubsection ‹replace›
primrec replace :: "'a ⇒ 'a list ⇒ 'a list ⇒ 'a list" where
"replace x ys [] = []"
| "replace x ys (z#zs) =
(if z = x then ys @ zs else z # (replace x ys zs))"
primrec mapAt :: "nat list ⇒ ('a ⇒ 'a) ⇒ ('a list ⇒ 'a list)" where
"mapAt [] f as = as"
| "mapAt (n#ns) f as =
(if n < |as| then mapAt ns f (as[n:= f (as!n)])
else mapAt ns f as)"
lemma length_mapAt[simp]: "⋀xs. length(mapAt vs f xs) = length xs"
by(induct vs) auto
lemma length_replace1[simp]: "length(replace x [y] xs) = length xs"
by(induct xs) simp_all
lemma replace_id[simp]: "replace x [x] xs = xs"
by(induct xs) simp_all
lemma len_replace_ge_same:
"length ys ≥ 1 ⟹ length(replace x ys xs) ≥ length xs"
by (induct xs) auto
lemma len_replace_ge[simp]:
"⟦ length ys ≥ 1; length xs ≥ length zs ⟧ ⟹
length(replace x ys xs) ≥ length zs"
apply(drule len_replace_ge_same[where x = x and xs = xs])
apply arith
done
lemma replace_append[simp]:
"replace x ys (as @ bs) =
(if x ∈ set as then replace x ys as @ bs else as @ replace x ys bs)"
by(induct as) auto
lemma distinct_set_replace: "distinct xs ⟹
set (replace x ys xs) =
(if x ∈ set xs then (set xs - {x}) ∪ set ys else set xs)"
apply(induct xs)
apply(simp)
apply simp
apply blast
done
lemma replace1:
"f ∈ set (replace f' fs ls ) ⟹ f ∉ set ls ⟹ f ∈ set fs"
proof (induct ls)
case Nil then show ?case by simp
next
case (Cons l ls) then show ?case by (simp split: if_split_asm)
qed
lemma replace2:
"f' ∉ set ls ⟹ replace f' fs ls = ls"
proof (induct ls)
case Nil then show ?case by simp
next
case (Cons l ls) then show ?case by (auto split: if_split_asm)
qed
lemma replace3[intro]:
"f' ∈ set ls ⟹ f ∈ set fs ⟹ f ∈ set (replace f' fs ls)"
by (induct ls) auto
lemma replace4:
"f ∈ set ls ⟹ oldF ≠ f ⟹ f ∈ set (replace oldF fs ls)"
by (induct ls) auto
lemma replace5: "f ∈ set (replace oldF newfs fs) ⟹ f ∈ set fs ∨ f ∈ set newfs"
by (induct fs) (auto split: if_split_asm)
lemma replace6: "distinct oldfs ⟹ x ∈ set (replace oldF newfs oldfs) =
((x ≠ oldF ∨ oldF ∈ set newfs) ∧ ((oldF ∈ set oldfs ∧ x ∈ set newfs) ∨ x ∈ set oldfs))"
by (induct oldfs) auto
lemma distinct_replace:
"distinct fs ⟹ distinct newFs ⟹ set fs ∩ set newFs ⊆ {oldF} ⟹
distinct (replace oldF newFs fs)"
proof (induct fs)
case Nil then show ?case by simp
next
case (Cons f fs)
then show ?case
proof (cases "f = oldF")
case True with Cons show ?thesis by simp blast
next
case False
moreover with Cons have "f ∉ set newFs" by simp blast
with Cons have "f ∉ set (replace oldF newFs fs)"
by simp (blast dest: replace1)
moreover from Cons have "distinct (replace oldF newFs fs)"
by (rule_tac Cons) auto
ultimately show ?thesis by simp
qed
qed
lemma replace_replace[simp]: "oldf ∉ set newfs ⟹ distinct xs ⟹
replace oldf newfs (replace oldf newfs xs) = replace oldf newfs xs"
apply (induct xs) apply auto apply (rule replace2) by simp
lemma replace_distinct: "distinct fs ⟹ distinct newfs ⟹ oldf ∈ set fs ⟶ set newfs ∩ set fs ⊆ {oldf} ⟹
distinct (replace oldf newfs fs)"
apply (case_tac "oldf ∈ set fs") apply simp
apply (induct fs) apply simp
apply (auto simp: replace2) apply (drule replace1)
by auto
lemma filter_replace2:
"⟦ ¬ P x; ∀y∈ set ys. ¬ P y ⟧ ⟹
filter P (replace x ys xs) = filter P xs"
apply(cases "x ∈ set xs")
prefer 2 apply(simp add:replace2)
apply(induct xs)
apply simp
apply clarsimp
done
lemma length_filter_replace1:
"⟦ x ∈ set xs; ¬ P x ⟧ ⟹
length(filter P (replace x ys xs)) =
length(filter P xs) + length(filter P ys)"
apply(induct xs)
apply simp
apply fastforce
done
lemma length_filter_replace2:
"⟦ x ∈ set xs; P x ⟧ ⟹
length(filter P (replace x ys xs)) =
length(filter P xs) + length(filter P ys) - 1"
apply(induct xs)
apply simp
apply auto
apply(drule split_list)
apply clarsimp
done
subsubsection ‹@{const"distinct"}›
lemma dist_at1: "⋀ c vs. distinct vs ⟹ vs = a @ r # b ⟹ vs = c @ r # d ⟹ a = c"
proof (induct a)
case Nil
assume dist: "distinct vs" and vs1: "vs = [] @ r # b" and vs2: "vs = c @ r # d"
from dist vs2 have rc: "r ∉ set c" by auto
from vs1 vs2 have "c @ r # d = r # b" by auto
then have "hd (c @ r # d) = r" by auto
then have "c ≠ [] ⟹ hd c = r" by auto
then have "c ≠ [] ⟹ r ∈ set c" by (induct c) auto
with rc have c: "c = []" by auto
then show ?case by auto
next
case (Cons x xs) then show ?case by (induct c) auto
qed
lemma dist_at: "distinct vs ⟹ vs = a @ r # b ⟹ vs = c @ r # d ⟹ a = c ∧ b = d"
proof -
assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
then have "a = c" by (rule_tac dist_at1) auto
with dist vs1 vs2 show ?thesis by simp
qed
lemma dist_at2: "distinct vs ⟹ vs = a @ r # b ⟹ vs = c @ r # d ⟹ b = d"
proof -
assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
then have "a = c ∧ b = d" by (rule_tac dist_at) auto
then show ?thesis by auto
qed
lemma distinct_split1: "distinct xs ⟹ xs = y @ [r] @ z ⟹ r ∉ set y"
apply auto done
lemma distinct_split2: "distinct xs ⟹ xs = y @ [r] @ z ⟹ r ∉ set z" apply auto done
lemma distinct_hd_not_cons: "distinct vs ⟹ ∃ as bs. vs = as @ x # hd vs # bs ⟹ False"
proof -
assume d: "distinct vs" and ex: "∃ as bs. vs = as @ x # hd vs # bs"
from ex have vsne: "vs ≠ []" by auto
with d ex show ?thesis apply (elim exE) apply (case_tac "as")
apply (subgoal_tac "hd vs = x") apply simp apply (rule sym) apply simp
apply (subgoal_tac "x = hd (x # (hd vs # bs))") apply simp apply (thin_tac "vs = x # hd vs # bs")
apply auto
apply (subgoal_tac "hd vs = a") apply simp
apply (subgoal_tac "a = hd (a # list @ x # hd vs # bs)") apply simp
apply (thin_tac "vs = a # list @ x # hd vs # bs") by auto
qed
subsubsection ‹Misc›
lemma drop_last_in: "⋀n. n < length ls ⟹ last ls ∈ set (drop n ls)"
apply (frule_tac last_drop) apply(erule subst)
apply (case_tac "drop n ls" rule: rev_exhaust) by simp_all
lemma nth_last_Suc_n: "distinct ls ⟹ n < length ls ⟹ last ls = ls ! n ⟹ Suc n = length ls"
proof (rule ccontr)
assume d: "distinct ls" and n: "n < length ls" and l: "last ls = ls ! n" and not: "Suc n ≠ length ls"
then have s: "Suc n < length ls" by auto
define lls where "lls = ls!n"
with n have "take (Suc n) ls = take n ls @ [lls]" apply simp by (rule take_Suc_conv_app_nth)
then have "take (Suc n) ls @ drop (Suc n) ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
then have ls: "ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
with d have dls: "distinct (take n ls @ [lls] @ drop (Suc n) ls)" by auto
from lls_def l have "lls = (last ls)" by auto
with s have "lls ∈ set (drop (Suc n) ls)" apply simp by (rule_tac drop_last_in)
with dls show False by auto
qed
subsubsection ‹@{const rotate}›
lemma plus_length1[simp]: "rotate (k+(length ls)) ls = rotate k ls "
proof -
have "⋀ k ls. rotate k (rotate (length ls) ls) = rotate (k+(length ls)) ls"
by (rule rotate_rotate)
then have "⋀ k ls. rotate k ls = rotate (k+(length ls)) ls" by auto
then show ?thesis by (rule sym)
qed
lemma plus_length2[simp]: "rotate ((length ls)+k) ls = rotate k ls "
proof -
define x where "x = (length ls)+k"
then have "x = k+(length ls)" by auto
with x_def have "rotate x ls = rotate (k+(length ls)) ls" by simp
then have "rotate x ls = rotate k ls" by simp
with x_def show ?thesis by simp
qed
lemma rotate_minus1: "n > 0 ⟹ m > 0 ⟹
rotate n ls = rotate m ms ⟹ rotate (n - 1) ls = rotate (m - 1) ms"
proof (cases "ls = []")
assume r: "rotate n ls = rotate m ms"
case True with r
have "rotate m ms = []" by auto
then have "ms = []" by auto
with True show ?thesis by auto
next
assume n: "n > 0" and m: "m > 0" and r: "rotate n ls = rotate m ms"
case False
then have lls: "length ls > 0" by auto
with r have lms: "length ms > 0" by auto
have mem1: "rotate (n - 1) ls = rotate ((n - 1) + length ls) ls" by auto
from n lls have "(n - 1) + length ls = (length ls - 1) + n" by arith
then have "rotate ((n - 1) + length ls) ls = rotate ((length ls - 1) + n) ls" by auto
with mem1 have mem2: "rotate (n - 1) ls = rotate ((length ls - 1) + n) ls" by auto
have "rotate ((length ls - 1) + n) ls = rotate (length ls - 1) (rotate n ls)" apply (rule sym)
by (rule rotate_rotate)
with mem2 have mem3: "rotate (n - 1) ls = rotate (length ls - 1) (rotate n ls)" by auto
from r have "rotate (length ls - 1) (rotate n ls) = rotate (length ls - 1) (rotate m ms)" by auto
with mem3 have mem4: "rotate (n - 1) ls = rotate (length ls - 1) (rotate m ms)" by auto
have "rotate (length ls - 1) (rotate m ms) = rotate (length ls - 1 + m) ms" by (rule rotate_rotate)
with mem4 have mem5: "rotate (n - 1) ls = rotate (length ls - 1 + m) ms" by auto
from r have "length (rotate n ls) = length (rotate m ms)" by simp
then have "length ls = length ms" by auto
with m lms have "length ls - 1 + m = (m - 1) + length ms" by arith
with mem5 have mem6: "rotate (n - 1) ls = rotate ((m - 1) + length ms) ms" by auto
have "rotate ((m - 1) + length ms) ms = rotate (m - 1) (rotate (length ms) ms)" by auto
then have "rotate ((m - 1) + length ms) ms = rotate (m - 1) ms" by auto
with mem6 show ?thesis by auto
qed
lemma rotate_minus1': "n > 0 ⟹ rotate n ls = ms ⟹
rotate (n - 1) ls = rotate (length ms - 1) ms"
proof (cases "ls = []")
assume r: "rotate n ls = ms"
case True with r show ?thesis by auto
next
assume n: "n > 0" and r:"rotate n ls = ms"
then have r': "rotate n ls = rotate (length ms) ms" by auto
case False
with n r' show ?thesis apply (rule_tac rotate_minus1) by auto
qed
lemma rotate_inv1: "⋀ ms. n < length ls ⟹ rotate n ls = ms ⟹
ls = rotate ((length ls) - n) ms"
proof (induct n)
case 0 then show ?case by auto
next
case (Suc n) then show ?case
proof (cases "ls = []")
case True with Suc
show ?thesis by auto
next
case False
then have ll: "length ls > 0" by auto
from Suc have nl: "n < length ls" by auto
from Suc have r: "rotate (Suc n) ls = ms" by auto
then have "rotate (Suc n - 1) ls = rotate (length ms - 1) ms" apply (rule_tac rotate_minus1') by auto
then have "rotate n ls = rotate (length ms - 1) ms" by auto
then have mem: "ls = rotate (length ls - n) (rotate (length ms - 1) ms)"
apply (rule_tac Suc) by (auto simp: nl)
have " rotate (length ls - n) (rotate (length ms - 1) ms) = rotate (length ls - n + (length ms - 1)) ms"
by (rule rotate_rotate)
with mem have mem2: "ls = rotate (length ls - n + (length ms - 1)) ms" by auto
from r have leq: "length ms = length ls" by auto
with False nl have "length ls - n + (length ms - 1) = length ms + (length ms - (Suc n))"
by arith
then have "rotate (length ls - n + (length ms - 1)) ms = rotate (length ms + (length ms - (Suc n))) ms"
by auto
with mem2 have mem3: "ls = rotate (length ms + (length ms - (Suc n))) ms" by auto
have "rotate (length ms + (length ms - (Suc n))) ms = rotate (length ms - (Suc n)) ms" by simp
with mem3 leq show ?thesis by auto
qed
qed
lemma rotate_conv_mod'[simp]: "rotate (n mod length ls) ls = rotate n ls"
by(simp add:rotate_drop_take)
lemma rotate_inv2: "rotate n ls = ms ⟹
ls = rotate ((length ls) - (n mod length ls)) ms"
proof (cases "ls = []")
assume r: "rotate n ls = ms"
case True with r show ?thesis by auto
next
assume r: "rotate n ls = ms"
then have r': "rotate (n mod length ls) ls = ms" by auto
case False
then have "length ls > 0" by auto
with r' show ?thesis apply (rule_tac rotate_inv1) by auto
qed
lemma rotate_id[simp]: "rotate ((length ls) - (n mod length ls)) (rotate n ls) = ls"
apply (rule sym) apply (rule rotate_inv2) by simp
lemma nth_rotate1_Suc: "Suc n < length ls ⟹ ls!(Suc n) = (rotate1 ls)!n"
apply (cases ls) apply auto
by (simp add: nth_append)
lemma nth_rotate1_0: "ls!0 = (rotate1 ls)!(length ls - 1)" apply (cases ls) by auto
lemma nth_rotate1: "0 < length ls ⟹ ls!((Suc n) mod (length ls)) = (rotate1 ls)!(n mod (length ls))"
proof (cases "0 < (Suc n) mod (length ls)")
assume lls: "0 < length ls"
case True
define m where "m = (Suc n) mod (length ls) - 1"
with True have m: "Suc m = (Suc n) mod (length ls)" by auto
with lls have a: "(Suc m) < length ls" by auto
from lls m have "m = n mod (length ls)" by (simp add: mod_Suc split:if_split_asm)
with a m show ?thesis apply (drule_tac nth_rotate1_Suc) by auto
next
assume lls: "0 < length ls"
case False
then have a: "(Suc n) mod (length ls) = 0" by auto
with lls have "Suc (n mod (length ls)) = (length ls)" by (auto simp: mod_Suc split: if_split_asm)
then have "(n mod (length ls)) = (length ls) - 1" by arith
with a show ?thesis by (auto simp: nth_rotate1_0)
qed
lemma rotate_Suc2[simp]: "rotate n (rotate1 xs) = rotate (Suc n) xs"
apply (simp add:rotate_def) apply (induct n) by auto
lemma nth_rotate: "⋀ ls. 0 < length ls ⟹ ls!((n+m) mod (length ls)) = (rotate m ls)!(n mod (length ls))"
proof (induct m)
case 0 then show ?case by auto
next
case (Suc m)
define z where "z = n + m"
then have "n + Suc m = Suc (z)" by auto
with Suc have r1: "ls ! ((Suc z) mod length ls) = rotate1 ls ! (z mod length ls)"
by (rule_tac nth_rotate1)
from Suc have "0 < length (rotate1 ls)" by auto
then have "(rotate1 ls) ! ((n + m) mod length (rotate1 ls))
= rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by (rule Suc)
with r1 z_def have "ls ! ((n + Suc m) mod length ls)
= rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by auto
then show ?case by auto
qed
subsection ‹‹splitAt››
primrec splitAtRec :: "'a ⇒ 'a list ⇒ 'a list ⇒ 'a list × 'a list" where
"splitAtRec c bs [] = (bs,[])"
| "splitAtRec c bs (a#as) = (if a = c then (bs, as)
else splitAtRec c (bs@[a]) as)"
definition splitAt :: "'a ⇒ 'a list ⇒ 'a list × 'a list" where
"splitAt c as ≡ splitAtRec c [] as"
subsubsection ‹@{const splitAtRec}›
lemma splitAtRec_conv: "⋀bs.
splitAtRec x bs xs =
(bs @ takeWhile (λy. y≠x) xs, tl(dropWhile (λy. y≠x) xs))"
by(induct xs) auto
lemma splitAtRec_distinct_fst: "⋀ s. distinct vs ⟹ distinct s ⟹ (set s) ∩ (set vs) = {} ⟹ distinct (fst (splitAtRec ram1 s vs))"
by (induct vs) auto
lemma splitAtRec_distinct_snd: "⋀ s. distinct vs ⟹ distinct s ⟹ (set s) ∩ (set vs) = {} ⟹ distinct (snd (splitAtRec ram1 s vs))"
by (induct vs) auto
lemma splitAtRec_ram:
"⋀ us a b. ram ∈ set vs ⟹ (a, b) = splitAtRec ram us vs ⟹
us @ vs = a @ [ram] @ b"
proof (induct vs)
case Nil then show ?case by simp
next
case (Cons v vs) then show ?case by (auto dest: Cons(1) split: if_split_asm)
qed
lemma splitAtRec_notRam:
"⋀ us. ram ∉ set vs ⟹ splitAtRec ram us vs = (us @ vs, [])"
proof (induct vs)
case Nil then show ?case by simp
next
case (Cons v vs) then show ?case by auto
qed
lemma splitAtRec_distinct: "⋀ s. distinct vs ⟹
distinct s ⟹ (set s) ∩ (set vs) = {} ⟹
set (fst (splitAtRec ram s vs)) ∩ set (snd (splitAtRec ram s vs)) = {}"
by (induct vs) auto
subsubsection ‹@{const splitAt}›
lemma splitAt_conv:
"splitAt x xs = (takeWhile (λy. y≠x) xs, tl(dropWhile (λy. y≠x) xs))"
by(simp add: splitAt_def splitAtRec_conv)
lemma splitAt_no_ram[simp]:
"ram ∉ set vs ⟹ splitAt ram vs = (vs, [])"
by (auto simp: splitAt_def splitAtRec_notRam)
lemma splitAt_split:
"ram ∈ set vs ⟹ (a,b) = splitAt ram vs ⟹ vs = a @ ram # b"
by (auto simp: splitAt_def dest: splitAtRec_ram)
lemma splitAt_ram:
"ram ∈ set vs ⟹ vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)"
by (rule_tac splitAt_split) auto
lemma fst_splitAt_last:
"⟦ xs ≠ []; distinct xs ⟧ ⟹ fst (splitAt (last xs) xs) = butlast xs"
by(simp add:splitAt_conv takeWhile_not_last)
subsubsection ‹Sets›
lemma splitAtRec_union:
"⋀ a b s. (a,b) = splitAtRec ram s vs ⟹ (set a ∪ set b) - {ram} = (set vs ∪ set s) - {ram}"
apply (induct vs) by (auto split: if_split_asm)
lemma splitAt_subset_ab:
"(a,b) = splitAt ram vs ⟹ set a ⊆ set vs ∧ set b ⊆ set vs"
apply (cases "ram ∈ set vs")
by (auto dest: splitAt_split simp: splitAt_no_ram)
lemma splitAt_in_fst[dest]: "v ∈ set (fst (splitAt ram vs)) ⟹ v ∈ set vs"
proof (cases "ram ∈ set vs")
assume v: "v ∈ set (fst (splitAt ram vs))"
define a where "a = fst (splitAt ram vs)"
with v have vin: "v ∈ set a" by auto
define b where "b = snd (splitAt ram vs)"
case True with a_def b_def have "vs = a @ ram # b" by (auto dest: splitAt_ram)
with vin show "v ∈ set vs" by auto
next
assume v: "v ∈ set (fst (splitAt ram vs))"
case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed
lemma splitAt_not1:
"v ∉ set vs ⟹ v ∉ set (fst (splitAt ram vs))" by (auto dest: splitAt_in_fst)
lemma splitAt_in_snd[dest]: "v ∈ set (snd (splitAt ram vs)) ⟹ v ∈ set vs"
proof (cases "ram ∈ set vs")
assume v: "v ∈ set (snd (splitAt ram vs))"
define a where "a = fst (splitAt ram vs)"
define b where "b = snd (splitAt ram vs)"
with v have vin: "v ∈ set b" by auto
case True with a_def b_def have "vs = a @ ram # b" by (auto dest: splitAt_ram)
with vin show "v ∈ set vs" by auto
next
assume v: "v ∈ set (snd (splitAt ram vs))"
case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed
subsubsection ‹Distinctness›
lemma splitAt_distinct_ab_aux:
"distinct vs ⟹ (a,b) = splitAt ram vs ⟹ distinct a ∧ distinct b"
by (cases "ram ∈ set vs") (auto dest: splitAt_split simp: splitAt_no_ram)
lemma splitAt_distinct_fst_aux[intro]:
"distinct vs ⟹ distinct (fst (splitAt ram vs))"
proof -
assume d: "distinct vs"
define b where "b = snd (splitAt ram vs)"
define a where "a = fst (splitAt ram vs)"
with b_def have "(a,b) = splitAt ram vs" by auto
with a_def d show ?thesis by (auto dest: splitAt_distinct_ab_aux)
qed
lemma splitAt_distinct_snd_aux[intro]:
"distinct vs ⟹ distinct (snd (splitAt ram vs))"
proof -
assume d: "distinct vs"
define b where "b = snd (splitAt ram vs)"
define a where "a = fst (splitAt ram vs)"
with b_def have "(a,b) = splitAt ram vs" by auto
with b_def d show ?thesis by (auto dest: splitAt_distinct_ab_aux)
qed
lemma splitAt_distinct_ab:
"distinct vs ⟹ (a,b) = splitAt ram vs ⟹ set a ∩ set b = {}"
apply (cases "ram ∈ set vs") apply (drule_tac splitAt_split)
by (auto simp: splitAt_no_ram)
lemma splitAt_distinct_fst_snd:
"distinct vs ⟹ set (fst (splitAt ram vs)) ∩ set (snd (splitAt ram vs)) = {}"
by (rule_tac splitAt_distinct_ab) simp_all
lemma splitAt_distinct_ram_fst[intro]:
"distinct vs ⟹ ram ∉ set (fst (splitAt ram vs))"
apply (case_tac "ram ∈ set vs") apply (drule_tac splitAt_ram)
apply (rule distinct_split1) by (force dest: splitAt_in_fst)+
lemma splitAt_distinct_ram_snd[intro]:
"distinct vs ⟹ ram ∉ set (snd (splitAt ram vs))"
apply (case_tac "ram ∈ set vs") apply (drule_tac splitAt_ram)
apply (rule distinct_split2) by (force dest: splitAt_in_fst)+
lemma splitAt_1[simp]:
"splitAt ram [] = ([],[])" by (simp add: splitAt_def)
lemma splitAt_2:
"v ∈ set vs ⟹ (a,b) = splitAt ram vs ⟹ v ∈ set a ∨ v ∈ set b ∨ v = ram "
apply (cases "ram ∈ set vs")
by (auto dest: splitAt_split simp: splitAt_no_ram)
lemma splitAt_distinct_fst: "distinct vs ⟹ distinct (fst (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_fst)
lemma splitAt_distinct_a: "distinct vs ⟹ (a,b) = splitAt ram vs ⟹ distinct a"
by (auto dest: splitAt_distinct_fst pairD)
lemma splitAt_distinct_snd: "distinct vs ⟹ distinct (snd (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_snd)
lemma splitAt_distinct_b: "distinct vs ⟹ (a,b) = splitAt ram vs ⟹ distinct b"
by (auto dest: splitAt_distinct_snd pairD)
lemma splitAt_distinct: "distinct vs ⟹ set (fst (splitAt ram vs)) ∩ set (snd (splitAt ram vs)) = {}"
by (simp add: splitAt_def splitAtRec_distinct)
lemma splitAt_subset: "(a,b) = splitAt ram vs ⟹ (set a ⊆ set vs) ∧ (set b ⊆ set vs)"
apply (cases "ram ∈ set vs") by (auto dest: splitAt_split simp: splitAt_no_ram)
subsubsection ‹@{const splitAt} composition›
lemma set_help: "v ∈ set ( as @ bs) ⟹ v ∈ set as ∨ v ∈ set bs" by auto
lemma splitAt_elements: "ram1 ∈ set vs ⟹ ram2 ∈ set vs ⟹ ram2 ∈ set( fst (splitAt ram1 vs)) ∨ ram2 ∈ set [ram1] ∨ ram2 ∈ set( snd (splitAt ram1 vs))"
proof -
assume r1: "ram1 ∈ set vs" and r2: "ram2 ∈ set vs"
then have "ram2 ∈ set( fst (splitAt ram1 vs) @ [ram1]) ∨ ram2 ∈ set( snd (splitAt ram1 vs))"
apply (rule_tac set_help)
apply (drule_tac splitAt_ram) by auto
then show ?thesis by auto
qed
lemma splitAt_ram3: "ram2 ∉ set (fst (splitAt ram1 vs)) ⟹
ram1 ∈ set vs ⟹ ram2 ∈ set vs ⟹ ram1 ≠ ram2 ⟹
ram2 ∈ set (snd (splitAt ram1 vs))" by (auto dest: splitAt_elements)
lemma splitAt_dist_ram: "distinct vs ⟹
vs = a @ ram # b ⟹ (a,b) = splitAt ram vs"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram # b"
from vs have r:"ram ∈ set vs" by auto
with dist vs have "fst (splitAt ram vs) = a" apply (drule_tac splitAt_ram) by (rule_tac dist_at1) auto
then have first:"a = fst (splitAt ram vs)" by auto
from r dist have second: "b = snd (splitAt ram vs)" apply (drule_tac splitAt_ram) apply (rule dist_at2) apply simp
by (auto simp: vs)
show ?thesis by (auto simp: first second)
qed
lemma distinct_unique1: "distinct vs ⟹ ram ∈ set vs ⟹ ∃!s. vs = (fst s) @ ram # (snd s)"
proof
assume d: "distinct vs" and r: "ram ∈ set vs"
define s where "s = splitAt ram vs"
with r show "vs = (fst s) @ ram # (snd s)"
by (auto intro: splitAt_ram)
next
fix s
assume d: "distinct vs" and vs1: "vs = fst s @ ram # snd s"
from d vs1 show "s = splitAt ram vs" apply (drule_tac splitAt_dist_ram) apply simp by simp
qed
lemma splitAt_dist_ram2: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹
(a @ ram1 # b, c) = splitAt ram2 vs"
by (auto intro: splitAt_dist_ram)
lemma splitAt_dist_ram20: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹
c = snd (splitAt ram2 vs)"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then show "c = snd (splitAt ram2 vs)" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
qed
lemma splitAt_dist_ram21: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ (a, b) = splitAt ram1 (fst (splitAt ram2 vs))"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then have "fst (splitAt ram2 vs) = a @ ram1 # b" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
with dist vs show ?thesis by (rule_tac splitAt_dist_ram) auto
qed
lemma splitAt_dist_ram22: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ (c, []) = splitAt ram1 (snd (splitAt ram2 vs))"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then have "snd (splitAt ram2 vs) = c" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
with dist vs have "splitAt ram1 (snd (splitAt ram2 vs)) = (c, [])" by (auto intro: splitAt_no_ram)
then show ?thesis by auto
qed
lemma splitAt_dist_ram1: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ (a, b @ ram2 # c) = splitAt ram1 vs"
by (auto intro: splitAt_dist_ram)
lemma splitAt_dist_ram10: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ a = fst (splitAt ram1 vs)"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then show "a = fst (splitAt ram1 vs)" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
qed
lemma splitAt_dist_ram11: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ (a, []) = splitAt ram2 (fst (splitAt ram1 vs))"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then have "fst (splitAt ram1 vs) = a" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
with dist vs have "splitAt ram2 (fst (splitAt ram1 vs)) = (a, [])" by (auto intro: splitAt_no_ram)
then show ?thesis by auto
qed
lemma splitAt_dist_ram12: "distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c ⟹ (b, c) = splitAt ram2 (snd (splitAt ram1 vs))"
proof -
assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
then have "snd (splitAt ram1 vs) = b @ ram2 # c" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
with dist vs show ?thesis by (rule_tac splitAt_dist_ram) auto
qed
lemma splitAt_dist_ram_all:
"distinct vs ⟹ vs = a @ ram1 # b @ ram2 # c
⟹ (a, b) = splitAt ram1 (fst (splitAt ram2 vs))
∧ (c, []) = splitAt ram1 (snd (splitAt ram2 vs))
∧ (a, []) = splitAt ram2 (fst (splitAt ram1 vs))
∧ (b, c) = splitAt ram2 (snd (splitAt ram1 vs))
∧ c = snd (splitAt ram2 vs)
∧ a = fst (splitAt ram1 vs)"
apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram21) apply simp apply simp
apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram22) apply simp apply simp
apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram11 splitAt_dist_ram22) apply simp apply simp
apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram12)apply simp apply simp
apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram20) apply simp apply simp
by (rule_tac splitAt_dist_ram10) auto
subsubsection ‹Mixed›
lemma fst_splitAt_rev:
"distinct xs ⟹ x ∈ set xs ⟹
fst(splitAt x (rev xs)) = rev(snd(splitAt x xs))"
by(simp add:splitAt_conv takeWhile_neq_rev)
lemma snd_splitAt_rev:
"distinct xs ⟹ x ∈ set xs ⟹
snd(splitAt x (rev xs)) = rev(fst(splitAt x xs))"
by(simp add:splitAt_conv dropWhile_neq_rev)
lemma splitAt_take[simp]: "distinct ls ⟹ i < length ls ⟹ fst (splitAt (ls!i) ls) = take i ls"
proof -
assume d: "distinct ls" and si: "i < length ls"
then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
from si have "ls!i ∈ set ls" by auto
then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls ∧ snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
then show ?thesis by auto
qed
lemma splitAt_drop[simp]: "distinct ls ⟹ i < length ls ⟹ snd (splitAt (ls!i) ls) = drop (Suc i) ls"
proof -
assume d: "distinct ls" and si: "i < length ls"
then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
from si have "ls!i ∈ set ls" by auto
then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls ∧ snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
then show ?thesis by auto
qed
lemma fst_splitAt_upt:
"j ≤ i ⟹ i < k ⟹ fst(splitAt i [j..<k]) = [j..<i]"
using splitAt_take[where ls = "[j..<k]" and i="i-j"]
apply (simp del:splitAt_take)
done
lemma snd_splitAt_upt:
"j ≤ i ⟹ i < k ⟹ snd(splitAt i [j..<k]) = [i+1..<k]"
using splitAt_drop[where ls = "[j..<k]" and i="i-j"]
by simp
lemma local_help1: "⋀ a vs. vs = c @ r # d ⟹ vs = a @ r # b ⟹ r ∉ set a ⟹ r ∉ set b ⟹ a = c"
proof (induct c)
case Nil
then have ra: "r ∉ set a" and vs1: "vs = a @ r # b" and vs2: "vs = [] @ r # d"
by auto
from vs1 vs2 have "a @ r # b = r # d" by auto
then have "hd (a @ r # b) = r" by auto
then have "a ≠ [] ⟹ hd a = r" by auto
then have "a ≠ [] ⟹ r ∈ set a" by (induct a) auto
with ra have a: "a = []" by auto
then show ?case by auto
next
case (Cons x xs) then show ?case by (induct a) auto
qed
lemma local_help: "vs = a @ r # b ⟹ vs = c @ r # d ⟹ r ∉ set a ⟹ r ∉ set b ⟹ a = c ∧ b = d"
proof -
assume dist: "r ∉ set a" "r ∉ set b" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
from vs2 vs1 dist have "a = c" by (rule local_help1)
with dist vs1 vs2 show ?thesis by simp
qed
lemma local_help': "a @ r # b = c @ r # d ⟹ r ∉ set a ⟹ r ∉ set b ⟹ a = c ∧ b = d"
by (rule local_help) auto
lemma splitAt_simp1: "ram ∉ set a ⟹ ram ∉ set b ⟹ fst (splitAt ram (a @ ram # b)) = a "
proof -
assume ramab: "ram ∉ set a" "ram ∉ set b"
define vs where "vs = a @ ram # b"
then have vs: "vs = a @ ram # b" by auto
then have "ram ∈ set vs" by auto
then have "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)" by (auto dest: splitAt_ram)
with vs ramab show ?thesis apply simp apply (rule_tac sym) apply (rule_tac local_help1) apply simp
apply (rule sym) apply assumption by auto
qed
lemma help'''_in: "⋀ xs. ram ∈ set b ⟹ fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs) show ?case using Cons(2)
apply (case_tac "b = ram") apply simp
apply simp
apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
apply (rule Cons) apply force
apply (rule Cons) by force
qed
lemma help'''_notin: "⋀ xs. ram ∉ set b ⟹ fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs)
then have "ram ∉ set bs" by auto
then show ?case
apply (case_tac "b = ram") apply simp
apply simp
apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
apply (rule Cons) apply simp
apply (rule Cons) by simp
qed
lemma help''': "fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
apply (cases "ram ∈ set b")
apply (rule_tac help'''_in) apply simp
apply (rule_tac help'''_notin) apply simp done
lemma splitAt_simpA[simp]: "fst (splitAt ram (ram # b)) = []" by (simp add: splitAt_def)
lemma splitAt_simpB[simp]: "ram ≠ a ⟹ fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (simp add: splitAt_def)
apply (subgoal_tac "fst (splitAtRec ram [a] b) = [a] @ fst (splitAtRec ram [] b)") apply simp by (rule help''')
lemma splitAt_simpB'[simp]: "a ≠ ram ⟹ fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (rule splitAt_simpB) by auto
lemma splitAt_simpC[simp]: "ram ∉ set a ⟹ fst (splitAt ram (a @ b)) = a @ fst (splitAt ram b)"
apply (induct a) by auto
lemma help'''': "⋀ xs ys. snd (splitAtRec ram xs b) = snd (splitAtRec ram ys b)"
apply (induct b) by auto
lemma splitAt_simpD[simp]: "⋀ a. ram ≠ a ⟹ snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (simp add: splitAt_def)
by (rule help'''')
lemma splitAt_simpD'[simp]: "⋀ a. a ≠ ram ⟹ snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (rule splitAt_simpD) by auto
lemma splitAt_simpE[simp]: "snd (splitAt ram (ram # b)) = b" by (simp add: splitAt_def)
lemma splitAt_simpF[simp]: "ram ∉ set a ⟹ snd (splitAt ram (a @ b)) = snd (splitAt ram b) "
apply (induct a) by auto
lemma splitAt_rotate_pair_conv:
"⋀xs. ⟦ distinct xs; x ∈ set xs ⟧
⟹ snd (splitAt x (rotate n xs)) @ fst (splitAt x (rotate n xs)) =
snd (splitAt x xs) @ fst (splitAt x xs)"
apply(induct n) apply simp
apply(simp del:rotate_Suc2 add:rotate1_rotate_swap)
apply(case_tac xs) apply clarsimp+
apply(erule disjE) apply simp
apply(drule split_list)
apply clarsimp
done
subsection ‹‹between››
definition between :: "'a list ⇒ 'a ⇒ 'a ⇒ 'a list" where
"between vs ram⇩1 ram⇩2 ≡
let (pre⇩1, post⇩1) = splitAt ram⇩1 vs in
if ram⇩2 ∈ set post⇩1
then let (pre⇩2, post⇩2) = splitAt ram⇩2 post⇩1 in pre⇩2
else let (pre⇩2, post⇩2) = splitAt ram⇩2 pre⇩1 in post⇩1 @ pre⇩2"
lemma inbetween_inset:
"x ∈ set(between xs a b) ⟹ x ∈ set xs"
apply(simp add:between_def split_def split:if_split_asm)
apply(blast dest:splitAt_in_snd)
apply(blast dest:splitAt_in_snd)
done
lemma notinset_notinbetween:
"x ∉ set xs ⟹ x ∉ set(between xs a b)"
by(blast dest:inbetween_inset)
lemma set_between_id:
"distinct xs ⟹ x ∈ set xs ⟹
set(between xs x x) = set xs - {x}"
apply(drule split_list)
apply (clarsimp simp:between_def split_def Un_commute)
done
lemma split_between:
"⟦ distinct vs; r ∈ set vs; v ∈ set vs; u ∈ set(between vs r v) ⟧ ⟹
between vs r v =
(if r=u then [] else between vs r u @ [u]) @ between vs u v"
apply(cases "r = v")
apply(clarsimp)
apply(frule split_list[of v])
apply(clarsimp)
apply(simp add:between_def split_def split:if_split_asm)
apply(erule disjE)
apply(frule split_list[of u])
apply(clarsimp)
apply(frule split_list[of u])
apply(clarsimp)
apply(clarsimp)
apply(frule split_list[of r])
apply(clarsimp)
apply(rename_tac as bs)
apply(erule disjE)
apply(frule split_list[of v])
apply(clarsimp)
apply(rename_tac cs ds)
apply(subgoal_tac "between (cs @ v # ds @ r # bs) r v = bs @ cs")
prefer 2 apply(simp add:between_def split_def split:if_split_asm)
apply simp
apply(erule disjE)
apply(frule split_list[of u])
apply(clarsimp simp:between_def split_def split:if_split_asm)
apply(frule split_list[of u])
apply(clarsimp simp:between_def split_def split:if_split_asm)
apply(frule split_list[of v])
apply(clarsimp)
apply(rename_tac cs ds)
apply(subgoal_tac "between (as @ r # cs @ v # ds) r v = cs")
prefer 2 apply(simp add:between_def split_def split:if_split_asm)
apply simp
apply(frule split_list[of u])
apply(clarsimp simp:between_def split_def split:if_split_asm)
done
subsection ‹Tables›
type_synonym ('a, 'b) table = "('a × 'b) list"
definition isTable :: "('a ⇒ 'b) ⇒ 'a list ⇒ ('a, 'b) table ⇒ bool" where
"isTable f vs t ≡ ∀p. p ∈ set t ⟶ snd p = f (fst p) ∧ fst p ∈ set vs"
lemma isTable_eq: "isTable E vs ((a,b)#ps) ⟹ b = E a"
by (auto simp add: isTable_def)
lemma isTable_subset:
"set qs ⊆ set ps ⟹ isTable E vs ps ⟹ isTable E vs qs"
by (unfold isTable_def) auto
lemma isTable_Cons: "isTable E vs ((a,b)#ps) ⟹ isTable E vs ps"
by (unfold isTable_def) auto
definition removeKey :: "'a ⇒ ('a × 'b) list ⇒ ('a × 'b) list" where
"removeKey a ps ≡ [p ← ps. a ≠ fst p]"
primrec removeKeyList :: "'a list ⇒ ('a × 'b) list ⇒ ('a × 'b) list" where
"removeKeyList [] ps = ps"
| "removeKeyList (w#ws) ps = removeKey w (removeKeyList ws ps)"
lemma removeKey_subset[simp]: "set (removeKey a ps) ⊆ set ps"
by (simp add: removeKey_def)
lemma length_removeKey[simp]: "|removeKey w ps| ≤ |ps|"
by (simp add: removeKey_def)
lemma length_removeKeyList:
"length (removeKeyList ws ps) ≤ length ps" (is "?P ws")
proof (induct ws)
show "?P []" by simp
fix w ws
have "length (removeKey w (removeKeyList ws ps))
≤ length (removeKeyList ws ps)"
by (rule length_removeKey)
also assume "?P ws"
finally show "?P (w#ws)" by simp
qed
lemma removeKeyList_subset[simp]: "set (removeKeyList ws ps) ⊆ set ps"
proof (induct ws)
case Nil then show ?case by simp
next
case (Cons w ws) then show ?case
by (metis dual_order.trans removeKeyList.simps(2) removeKey_subset)
qed
lemma notin_removeKey1: "(a, b) ∉ set (removeKey a ps)"
by (induct ps) (auto simp add: removeKey_def)
lemma removeKeyList_eq:
"removeKeyList as ps = [p ← ps. ∀a ∈ set as. a ≠ fst p]"
by (induct as) (simp_all add: filter_comm removeKey_def)
lemma removeKey_empty[simp]: "removeKey a [] = []"
by (simp add: removeKey_def)
lemma removeKeyList_empty[simp]: "removeKeyList ps [] = []"
by (induct ps) simp_all
lemma removeKeyList_cons[simp]:
"removeKeyList ws (p#ps)
= (if fst p ∈ set ws then removeKeyList ws ps else p#(removeKeyList ws ps))"
by (induct ws) (simp_all split: if_split_asm add: removeKey_def)
end
Theory Quasi_Order
theory Quasi_Order
imports Main
begin
locale quasi_order =
fixes qle :: "'a ⇒ 'a ⇒ bool" (infix "≼" 60)
assumes qle_refl[iff]: "x ≼ x"
and qle_trans: "x ≼ y ⟹ y ≼ z ⟹ x ≼ z"
begin
definition in_qle :: "'a ⇒ 'a set ⇒ bool" (infix "∈⇩≼" 60) where
"x ∈⇩≼ M ≡ ∃y ∈ M. x ≼ y"
definition subseteq_qle :: "'a set ⇒ 'a set ⇒ bool" (infix "⊆⇩≼" 60) where
"M ⊆⇩≼ N ≡ ∀x ∈ M. x ∈⇩≼ N"
definition seteq_qle :: "'a set ⇒ 'a set ⇒ bool" (infix "=⇩≼" 60) where
"M =⇩≼ N ≡ M ⊆⇩≼ N ∧ N ⊆⇩≼ M"
lemmas "defs" = in_qle_def subseteq_qle_def seteq_qle_def
lemma subseteq_qle_refl[simp]: "M ⊆⇩≼ M"
by(auto simp add: subseteq_qle_def in_qle_def)
lemma subseteq_qle_trans: "A ⊆⇩≼ B ⟹ B ⊆⇩≼ C ⟹ A ⊆⇩≼ C"
by (simp add: subseteq_qle_def in_qle_def) (metis qle_trans)
lemma empty_subseteq_qle[simp]: "{} ⊆⇩≼ A"
by (simp add: subseteq_qle_def)
lemma subseteq_qleI2: "(⋀x. x ∈ M ⟹ ∃y ∈ N. x ≼ y) ⟹ M ⊆⇩≼ N"
by (auto simp add: subseteq_qle_def in_qle_def)
lemma subseteq_qleD2: "M ⊆⇩≼ N ⟹ x ∈ M ⟹ ∃y ∈ N. x ≼ y"
by (auto simp add: subseteq_qle_def in_qle_def)
lemma seteq_qle_refl[iff]: "A =⇩≼ A"
by (simp add: seteq_qle_def)
lemma seteq_qle_trans: "A =⇩≼ B ⟹ B =⇩≼ C ⟹ A =⇩≼ C"
by (simp add: seteq_qle_def) (metis subseteq_qle_trans)
end
end
Theory PlaneGraphIso
section‹Isomorphisms Between Plane Graphs›
theory PlaneGraphIso
imports Main Quasi_Order
begin
lemma image_image_id_if[simp]: "(⋀x. f(f x) = x) ⟹ f ` f ` M = M"
by (auto simp: image_iff)
declare not_None_eq [iff] not_Some_eq [iff]
text‹The symbols ‹≅› and ‹≃› are overloaded. They
denote congruence and isomorphism on arbitrary types. On lists
(representing faces of graphs), ‹≅› means congruence modulo
rotation; ‹≃› is currently unused. On graphs, ‹≃›
means isomorphism and is a weaker version of ‹≅› (proper
isomorphism): ‹≃› also allows to reverse the orientation of
all faces.›
consts
pr_isomorphic :: "'a ⇒ 'a ⇒ bool" (infix "≅" 60)
definition Iso :: "('a list * 'a list) set" ("{≅}") where
"{≅} ≡ {(F⇩1, F⇩2). F⇩1 ≅ F⇩2}"
lemma [iff]: "((x,y) ∈ {≅}) = x ≅ y"
by(simp add:Iso_def)
text‹A plane graph is a set or list (for executability) of faces
(hence ‹Fgraph› and ‹fgraph›) and a face is a list of
nodes:›
type_synonym 'a Fgraph = "'a list set"
type_synonym 'a fgraph = "'a list list"
subsection‹Equivalence of faces›
text‹Two faces are equivalent modulo rotation:›
overloading "congs" ≡ "pr_isomorphic :: 'a list ⇒ 'a list ⇒ bool"
begin
definition "F⇩1 ≅ (F⇩2::'a list) ≡ ∃n. F⇩2 = rotate n F⇩1"
end
lemma congs_refl[iff]: "(xs::'a list) ≅ xs"
apply(simp add:congs_def)
apply(rule_tac x = 0 in exI)
apply (simp)
done
lemma congs_sym: assumes A: "(xs::'a list) ≅ ys" shows "ys ≅ xs"
proof (simp add:congs_def)
let ?l = "length xs"
from A obtain n where ys: "ys = rotate n xs" by(fastforce simp add:congs_def)
have "xs = rotate ?l xs" by simp
also have "… = rotate (?l - n mod ?l + n mod ?l) xs"
proof (cases)
assume "xs = []" thus ?thesis by simp
next
assume "xs ≠ []"
hence "n mod ?l < ?l" by simp
hence "?l = ?l - n mod ?l + n mod ?l" by arith
thus ?thesis by simp
qed
also have "… = rotate (?l - n mod ?l) (rotate (n mod ?l) xs)"
by(simp add:rotate_rotate)
also have "rotate (n mod ?l) xs = rotate n xs"
by(rule rotate_conv_mod[symmetric])
finally show "∃m. xs = rotate m ys" by(fastforce simp add:ys)
qed
lemma congs_trans: "(xs::'a list) ≅ ys ⟹ ys ≅ zs ⟹ xs ≅ zs"
apply(clarsimp simp:congs_def rotate_def)
apply(rename_tac m n)
apply(rule_tac x = "n+m" in exI)
apply (simp add:funpow_add)
done
lemma equiv_EqF: "equiv (UNIV::'a list set) {≅}"
apply(unfold equiv_def sym_def trans_def refl_on_def)
apply(rule conjI)
apply simp
apply(rule conjI)
apply(fastforce intro:congs_sym)
apply(fastforce intro:congs_trans)
done
lemma congs_distinct:
"F⇩1 ≅ F⇩2 ⟹ distinct F⇩2 = distinct F⇩1"
by (auto simp: congs_def)
lemma congs_length:
"F⇩1 ≅ F⇩2 ⟹ length F⇩2 = length F⇩1"
by (auto simp: congs_def)
lemma congs_pres_nodes: "F⇩1 ≅ F⇩2 ⟹ set F⇩1 = set F⇩2"
by(clarsimp simp:congs_def)
lemma congs_map:
"F⇩1 ≅ F⇩2 ⟹ map f F⇩1 ≅ map f F⇩2"
by (auto simp: congs_def rotate_map)
lemma congs_map_eq_iff:
"inj_on f (set xs ∪ set ys) ⟹ (map f xs ≅ map f ys) = (xs ≅ ys)"
apply(simp add:congs_def)
apply(rule iffI)
apply(clarsimp simp: rotate_map)
apply(drule map_inj_on)
apply(simp add:Un_commute)
apply (fastforce)
apply clarsimp
apply(fastforce simp: rotate_map)
done
lemma list_cong_rev_iff[simp]:
"(rev xs ≅ rev ys) = (xs ≅ ys)"
apply(simp add:congs_def rotate_rev)
apply(rule iffI)
apply fast
apply clarify
apply(cases "length xs = 0")
apply simp
apply(case_tac "n mod length xs = 0")
apply(rule_tac x = "n" in exI)
apply simp
apply(subst rotate_conv_mod)
apply(rule_tac x = "length xs - n mod length xs" in exI)
apply simp
done
lemma singleton_list_cong_eq_iff[simp]:
"({xs::'a list} // {≅} = {ys} // {≅}) = (xs ≅ ys)"
by(simp add: eq_equiv_class_iff2[OF equiv_EqF])
subsection‹Homomorphism and isomorphism›
definition is_pr_Hom :: "('a ⇒ 'b) ⇒ 'a Fgraph ⇒ 'b Fgraph ⇒ bool" where
"is_pr_Hom φ Fs⇩1 Fs⇩2 ≡ (map φ ` Fs⇩1)//{≅} = Fs⇩2 //{≅}"
definition is_pr_Iso :: "('a ⇒ 'b) ⇒ 'a Fgraph ⇒ 'b Fgraph ⇒ bool" where
"is_pr_Iso φ Fs⇩1 Fs⇩2 ≡ is_pr_Hom φ Fs⇩1 Fs⇩2 ∧ inj_on φ (⋃F ∈ Fs⇩1. set F)"
definition is_pr_iso :: "('a ⇒ 'b) ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"is_pr_iso φ Fs⇩1 Fs⇩2 ≡ is_pr_Iso φ (set Fs⇩1) (set Fs⇩2)"
text‹Homomorphisms preserve the set of nodes.›
lemma UN_subset_iff: "((⋃i∈I. f i) ⊆ B) = (∀i∈I. f i ⊆ B)"
by blast
declare Image_Collect_case_prod[simp del]
lemma pr_Hom_pres_face_nodes:
"is_pr_Hom φ Fs⇩1 Fs⇩2 ⟹ (⋃F∈Fs⇩1. {φ ` (set F)}) = (⋃F∈Fs⇩2. {set F})"
supply image_cong_simp [cong del]
apply(clarsimp simp:is_pr_Hom_def quotient_def)
apply auto
apply(subgoal_tac "∃F' ∈ Fs⇩2. {≅} `` {map φ F} = {≅} `` {F'}")
prefer 2 apply blast
apply (fastforce simp: eq_equiv_class_iff[OF equiv_EqF] dest!:congs_pres_nodes)
apply(subgoal_tac "∃F' ∈ Fs⇩1. {≅} `` {map φ F'} = {≅} `` {F}")
apply (fastforce simp: eq_equiv_class_iff[OF equiv_EqF] dest!:congs_pres_nodes)
apply (erule equalityE)
apply(fastforce simp:UN_subset_iff)
done
lemma pr_Hom_pres_nodes:
assumes "is_pr_Hom φ Fs⇩1 Fs⇩2"
shows "φ ` (⋃F∈Fs⇩1. set F) = (⋃F∈Fs⇩2. set F)"
proof
from assms have *: "(⋃F∈Fs⇩1. {φ ` set F}) = (⋃F∈Fs⇩2. {set F})"
by (rule pr_Hom_pres_face_nodes)
then show "φ ` (⋃F∈Fs⇩1. set F) ⊆ (⋃F∈Fs⇩2. set F)"
by blast
show "(⋃F∈Fs⇩2. set F) ⊆ φ ` (⋃F∈Fs⇩1. set F)"
proof
fix x
assume "x ∈ (⋃F∈Fs⇩2. set F)"
then obtain F where "F ∈ Fs⇩2" and "x ∈ set F" ..
then have "set F ∈ (⋃F∈Fs⇩2. {set F})"
by blast
then have "set F ∈ (⋃F∈Fs⇩1. {φ ` set F})"
using * by simp
then obtain F' where "F' ∈ Fs⇩1" and "set F ∈ {φ ` set F'}" ..
with ‹x ∈ set F› show "x ∈ φ ` (⋃F∈Fs⇩1. set F)"
by auto
qed
qed
text‹Therefore isomorphisms preserve cardinality of node set.›
lemma pr_Iso_same_no_nodes:
"⟦ is_pr_Iso φ Fs⇩1 Fs⇩2; finite Fs⇩1 ⟧
⟹ card(⋃F∈Fs⇩1. set F) = card(⋃F∈Fs⇩2. set F)"
by(clarsimp simp add: is_pr_Iso_def pr_Hom_pres_nodes[symmetric] card_image)
lemma pr_iso_same_no_nodes:
"is_pr_iso φ Fs⇩1 Fs⇩2 ⟹ card(⋃F∈set Fs⇩1. set F) = card(⋃F∈set Fs⇩2. set F)"
by(simp add: is_pr_iso_def pr_Iso_same_no_nodes)
text‹Isomorphisms preserve the number of faces.›
lemma pr_iso_same_no_faces:
assumes dist1: "distinct Fs⇩1" and dist2: "distinct Fs⇩2"
and inj1: "inj_on (λxs.{xs}//{≅}) (set Fs⇩1)"
and inj2: "inj_on (λxs.{xs}//{≅}) (set Fs⇩2)" and iso: "is_pr_iso φ Fs⇩1 Fs⇩2"
shows "length Fs⇩1 = length Fs⇩2"
proof -
have injphi: "∀F∈set Fs⇩1. ∀F'∈set Fs⇩1. inj_on φ (set F ∪ set F')" using iso
by(auto simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def inj_on_def)
have inj1': "inj_on (λxs. {xs} // {≅}) (map φ ` set Fs⇩1)"
apply(rule inj_on_imageI)
apply(simp add:inj_on_def quotient_def eq_equiv_class_iff[OF equiv_EqF])
apply(simp add: congs_map_eq_iff injphi)
using inj1
apply(simp add:inj_on_def quotient_def eq_equiv_class_iff[OF equiv_EqF])
done
have "length Fs⇩1 = card(set Fs⇩1)" by(simp add:distinct_card[OF dist1])
also have "… = card(map φ ` set Fs⇩1)" using iso
by(auto simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def inj_on_mapI card_image)
also have "… = card((map φ ` set Fs⇩1) // {≅})"
by(simp add: card_quotient_disjoint[OF _ inj1'])
also have "(map φ ` set Fs⇩1)//{≅} = set Fs⇩2 // {≅}"
using iso by(simp add: is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
also have "card(…) = card(set Fs⇩2)"
by(simp add: card_quotient_disjoint[OF _ inj2])
also have "… = length Fs⇩2" by(simp add:distinct_card[OF dist2])
finally show ?thesis .
qed
lemma is_Hom_distinct:
"⟦ is_pr_Hom φ Fs⇩1 Fs⇩2; ∀F∈Fs⇩1. distinct F; ∀F∈Fs⇩2. distinct F ⟧
⟹ ∀F∈Fs⇩1. distinct(map φ F)"
apply(clarsimp simp add:is_pr_Hom_def)
apply(subgoal_tac "∃ F' ∈ Fs⇩2. (map φ F, F') : {≅}")
apply(fastforce simp add: congs_def)
apply(subgoal_tac "∃ F' ∈ Fs⇩2. {map φ F}//{≅} = {F'}//{≅}")
apply clarify
apply(rule_tac x = F' in bexI)
apply(rule eq_equiv_class[OF _ equiv_EqF])
apply(simp add:singleton_quotient)
apply blast
apply assumption
apply(simp add:quotient_def)
apply(rotate_tac 1)
apply blast
done
lemma Collect_congs_eq_iff[simp]:
"Collect ((≅) x) = Collect ((≅) y) ⟷ (x ≅ (y::'a list))"
using eq_equiv_class_iff2[OF equiv_EqF]
apply(simp add: quotient_def Iso_def)
apply blast
done
lemma is_pr_Hom_trans: assumes f: "is_pr_Hom f A B" and g: "is_pr_Hom g B C"
shows "is_pr_Hom (g ∘ f) A C"
proof-
from f have f1: "∀a∈A. ∃b∈B. map f a ≅ b"
apply(simp add: is_pr_Hom_def quotient_def Iso_def)
apply(erule equalityE)
apply blast
done
from f have f2: "∀b∈B. ∃a∈A. map f a ≅ b"
apply(simp add: is_pr_Hom_def quotient_def Iso_def)
apply(erule equalityE)
apply blast
done
from g have g1: "∀b∈B. ∃c∈C. map g b ≅ c"
apply(simp add: is_pr_Hom_def quotient_def Iso_def)
apply(erule equalityE)
apply blast
done
from g have g2: "∀c∈C. ∃b∈B. map g b ≅ c"
apply(simp add: is_pr_Hom_def quotient_def Iso_def)
apply(erule equalityE)
apply blast
done
show ?thesis
apply(auto simp add: is_pr_Hom_def quotient_def Iso_def Image_def
map_comp_map[symmetric] image_comp simp del: map_map map_comp_map)
apply (metis congs_map[of _ _ g] congs_trans f1 g1)
by (metis congs_map[of _ _ g] congs_sym congs_trans f2 g2)
qed
lemma is_pr_Hom_rev:
"is_pr_Hom φ A B ⟹ is_pr_Hom φ (rev ` A) (rev ` B)"
apply(auto simp add: is_pr_Hom_def quotient_def Image_def Iso_def rev_map[symmetric])
apply(erule equalityE)
apply blast
apply(erule equalityE)
apply blast
done
text‹A kind of recursion rule, a first step towards executability:›
lemma is_pr_Iso_rec:
"⟦ inj_on (λxs. {xs}//{≅}) Fs⇩1; inj_on (λxs. {xs}//{≅}) Fs⇩2; F⇩1 ∈ Fs⇩1 ⟧ ⟹
is_pr_Iso φ Fs⇩1 Fs⇩2 =
(∃F⇩2 ∈ Fs⇩2. length F⇩1 = length F⇩2 ∧ is_pr_Iso φ (Fs⇩1 - {F⇩1}) (Fs⇩2 - {F⇩2})
∧ (∃n. map φ F⇩1 = rotate n F⇩2)
∧ inj_on φ (⋃F∈Fs⇩1. set F))"
apply(drule mk_disjoint_insert[of F⇩1])
apply clarify
apply(rename_tac Fs⇩1')
apply(rule iffI)
apply (clarsimp simp add:is_pr_Iso_def)
apply(clarsimp simp:is_pr_Hom_def quotient_diff1)
apply(drule_tac s="a // b" for a b in sym)
apply(clarsimp)
apply(subgoal_tac "{≅} `` {map φ F⇩1} : Fs⇩2 // {≅}")
prefer 2 apply(simp add:quotient_def)
apply(erule quotientE)
apply(rename_tac F⇩2)
apply(drule eq_equiv_class[OF _ equiv_EqF])
apply blast
apply(rule_tac x = F⇩2 in bexI)
prefer 2 apply assumption
apply(rule conjI)
apply(clarsimp simp: congs_def)
apply(rule conjI)
apply(subgoal_tac "{≅} `` {F⇩2} = {≅} `` {map φ F⇩1}")
prefer 2
apply(rule equiv_class_eq[OF equiv_EqF])
apply(fastforce intro: congs_sym)
apply(subgoal_tac "{F⇩2}//{≅} = {map φ F⇩1}//{≅}")
prefer 2 apply(simp add:singleton_quotient)
apply(subgoal_tac "∀F∈Fs⇩1'. ¬ (map φ F) ≅ (map φ F⇩1)")
apply(fastforce simp:Iso_def quotient_def Image_Collect_case_prod simp del: Collect_congs_eq_iff
dest!: eq_equiv_class[OF _ equiv_EqF])
apply clarify
apply(subgoal_tac "inj_on φ (set F ∪ set F⇩1)")
prefer 2
apply(erule subset_inj_on)
apply(blast)
apply(clarsimp simp add:congs_map_eq_iff)
apply(subgoal_tac "{≅} `` {F⇩1} = {≅} `` {F}")
apply(simp add:singleton_quotient)
apply(rule equiv_class_eq[OF equiv_EqF])
apply(blast intro:congs_sym)
apply(subgoal_tac "F⇩2 ≅ (map φ F⇩1)")
apply (simp add:congs_def inj_on_Un)
apply(clarsimp intro!:congs_sym)
apply(clarsimp simp add: is_pr_Iso_def is_pr_Hom_def quotient_diff1)
apply (simp add:singleton_quotient)
apply(subgoal_tac "F⇩2 ≅ (map φ F⇩1)")
prefer 2 apply(fastforce simp add:congs_def)
apply(subgoal_tac "{≅}``{map φ F⇩1} = {≅}``{F⇩2}")
prefer 2
apply(rule equiv_class_eq[OF equiv_EqF])
apply(fastforce intro:congs_sym)
apply(subgoal_tac "{≅}``{F⇩2} ∈ Fs⇩2 // {≅}")
prefer 2 apply(erule quotientI)
apply (simp add:insert_absorb quotient_def)
done
lemma is_iso_Cons:
"⟦ distinct (F⇩1#Fs⇩1'); distinct Fs⇩2;
inj_on (λxs.{xs}//{≅}) (set(F⇩1#Fs⇩1')); inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧
⟹
is_pr_iso φ (F⇩1#Fs⇩1') Fs⇩2 =
(∃F⇩2 ∈ set Fs⇩2. length F⇩1 = length F⇩2 ∧ is_pr_iso φ Fs⇩1' (remove1 F⇩2 Fs⇩2)
∧ (∃n. map φ F⇩1 = rotate n F⇩2)
∧ inj_on φ (set F⇩1 ∪ (⋃F∈set Fs⇩1'. set F)))"
apply(simp add:is_pr_iso_def)
apply(subst is_pr_Iso_rec[where ?F⇩1.0 = F⇩1])
apply(simp_all)
done
subsection‹Isomorphism tests›
lemma map_upd_submap:
"x ∉ dom m ⟹ (m(x ↦ y) ⊆⇩m m') = (m' x = Some y ∧ m ⊆⇩m m')"
apply(simp add:map_le_def dom_def)
apply(rule iffI)
apply(rule conjI) apply (blast intro:sym)
apply clarify
apply(case_tac "a=x")
apply auto
done
lemma map_of_zip_submap: "⟦ length xs = length ys; distinct xs ⟧ ⟹
(map_of (zip xs ys) ⊆⇩m Some ∘ f) = (map f xs = ys)"
apply(induct rule: list_induct2)
apply(simp)
apply (clarsimp simp: map_upd_submap simp del:o_apply fun_upd_apply)
apply simp
done
primrec pr_iso_test0 :: "('a ⇀ 'b) ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"pr_iso_test0 m [] Fs⇩2 = (Fs⇩2 = [])"
| "pr_iso_test0 m (F⇩1#Fs⇩1) Fs⇩2 =
(∃F⇩2 ∈ set Fs⇩2. length F⇩1 = length F⇩2 ∧
(∃n. let m' = map_of(zip F⇩1 (rotate n F⇩2)) in
if m ⊆⇩m m ++ m' ∧ inj_on (m++m') (dom(m++m'))
then pr_iso_test0 (m ++ m') Fs⇩1 (remove1 F⇩2 Fs⇩2) else False))"
lemma map_compatI: "⟦ f ⊆⇩m Some ∘ h; g ⊆⇩m Some ∘ h ⟧ ⟹ f ⊆⇩m f++g"
by (fastforce simp add: map_le_def map_add_def dom_def split:option.splits)
lemma inj_on_map_addI1:
"⟦ inj_on m A; m ⊆⇩m m++m'; A ⊆ dom m ⟧ ⟹ inj_on (m++m') A"
apply (clarsimp simp add: inj_on_def map_add_def map_le_def dom_def
split:option.splits)
apply(rule conjI)
apply fastforce
apply auto
apply fastforce
apply (rename_tac x a y)
apply(subgoal_tac "m x = Some a")
prefer 2 apply (fastforce)
apply(subgoal_tac "m y = Some a")
prefer 2 apply (fastforce)
apply(subgoal_tac "m x = m y")
prefer 2 apply simp
apply (blast)
done
lemma map_image_eq: "⟦ A ⊆ dom m; m ⊆⇩m m' ⟧ ⟹ m ` A = m' ` A"
by(force simp:map_le_def dom_def split:option.splits)
lemma inj_on_map_add_Un:
"⟦ inj_on m (dom m); inj_on m' (dom m'); m ⊆⇩m Some ∘ f; m' ⊆⇩m Some ∘ f;
inj_on f (dom m' ∪ dom m); A = dom m'; B = dom m ⟧
⟹ inj_on (m ++ m') (A ∪ B)"
apply(simp add:inj_on_Un)
apply(rule conjI)
apply(fastforce intro!: inj_on_map_addI1 map_compatI)
apply(clarify)
apply(subgoal_tac "m ++ m' ⊆⇩m Some ∘ f")
prefer 2 apply(fast intro:map_add_le_mapI map_compatI)
apply(subgoal_tac "dom m' - dom m ⊆ dom(m++m')")
prefer 2 apply(fastforce)
apply(insert map_image_eq[of "dom m' - dom m" "m++m'" "Some ∘ f"])
apply(subgoal_tac "dom m - dom m' ⊆ dom(m++m')")
prefer 2 apply(fastforce)
apply(insert map_image_eq[of "dom m - dom m'" "m++m'" "Some ∘ f"])
apply (clarsimp simp add: image_comp [symmetric])
apply blast
done
lemma map_of_zip_eq_SomeD: "length xs = length ys ⟹
map_of (zip xs ys) x = Some y ⟹ y ∈ set ys"
apply(induct rule:list_induct2)
apply simp
apply (auto split:if_splits)
done
lemma inj_on_map_of_zip:
"⟦ length xs = length ys; distinct ys ⟧
⟹ inj_on (map_of (zip xs ys)) (set xs)"
apply(induct rule:list_induct2)
apply simp
apply clarsimp
apply(rule conjI)
apply(erule inj_on_fun_updI)
apply(simp add:image_def)
apply clarsimp
apply(drule (1) map_of_zip_eq_SomeD[OF _ sym])
apply fast
apply(clarsimp simp add:image_def)
apply(drule (1) map_of_zip_eq_SomeD[OF _ sym])
apply fast
done
lemma pr_iso_test0_correct: "⋀m Fs⇩2.
⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2); inj_on m (dom m) ⟧ ⟹
pr_iso_test0 m Fs⇩1 Fs⇩2 =
(∃φ. is_pr_iso φ Fs⇩1 Fs⇩2 ∧ m ⊆⇩m Some ∘ φ ∧
inj_on φ (dom m ∪ (⋃F∈set Fs⇩1. set F)))"
apply(induct Fs⇩1)
apply(simp add:inj_on_def dom_def)
apply(rule iffI)
apply (simp add:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
apply(rule_tac x = "the ∘ m" in exI)
apply (fastforce simp: map_le_def)
apply (clarsimp simp:is_pr_iso_def is_pr_Iso_def is_pr_Hom_def)
apply(rename_tac F⇩1 Fs⇩1' m Fs⇩2)
apply(clarsimp simp:Let_def Ball_def)
apply(simp add: is_iso_Cons)
apply(rule iffI)
apply clarify
apply(clarsimp simp add:map_of_zip_submap inj_on_diff)
apply(rule_tac x = φ in exI)
apply(rule conjI)
apply(rule_tac x = F⇩2 in bexI)
prefer 2 apply assumption
apply(frule map_add_le_mapE)
apply(simp add:map_of_zip_submap is_pr_iso_def is_pr_Iso_def)
apply(rule conjI)
apply blast
apply(erule subset_inj_on)
apply blast
apply(rule conjI)
apply(blast intro: map_le_trans)
apply(erule subset_inj_on)
apply blast
apply(clarsimp simp: inj_on_diff)
apply(rule_tac x = F⇩2 in bexI)
prefer 2 apply assumption
apply simp
apply(rule_tac x = n in exI)
apply(rule conjI)
apply clarsimp
apply(rule_tac x = φ in exI)
apply simp
apply(rule conjI)
apply(fastforce intro!:map_add_le_mapI simp:map_of_zip_submap)
apply(simp add:Un_ac)
apply(rule context_conjI)
apply(simp add:map_of_zip_submap[symmetric])
apply(erule (1) map_compatI)
apply(simp add:map_of_zip_submap[symmetric])
apply(erule inj_on_map_add_Un)
apply(simp add:inj_on_map_of_zip)
apply assumption
apply assumption
apply simp
apply(erule subset_inj_on)
apply fast
apply simp
apply(rule refl)
done
corollary pr_iso_test0_corr:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
pr_iso_test0 Map.empty Fs⇩1 Fs⇩2 = (∃φ. is_pr_iso φ Fs⇩1 Fs⇩2)"
apply(subst pr_iso_test0_correct)
apply assumption+
apply simp
apply (simp add:is_pr_iso_def is_pr_Iso_def)
done
text‹Now we bound the number of rotations needed. We have to exclude
the empty face @{term"[]"} to be able to restrict the search to
@{prop"n < length xs"} (which would otherwise be vacuous).›
primrec pr_iso_test1 :: "('a ⇀ 'b) ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"pr_iso_test1 m [] Fs⇩2 = (Fs⇩2 = [])"
| "pr_iso_test1 m (F⇩1#Fs⇩1) Fs⇩2 =
(∃F⇩2 ∈ set Fs⇩2. length F⇩1 = length F⇩2 ∧
(∃n < length F⇩2. let m' = map_of(zip F⇩1 (rotate n F⇩2)) in
if m ⊆⇩m m ++ m' ∧ inj_on (m++m') (dom(m++m'))
then pr_iso_test1 (m ++ m') Fs⇩1 (remove1 F⇩2 Fs⇩2) else False))"
lemma test0_conv_test1:
"⋀m Fs⇩2. [] ∉ set Fs⇩2 ⟹ pr_iso_test1 m Fs⇩1 Fs⇩2 = pr_iso_test0 m Fs⇩1 Fs⇩2"
apply(induct Fs⇩1)
apply simp
apply simp
apply(rule iffI)
apply blast
apply (clarsimp simp:Let_def)
apply(rule_tac x = F⇩2 in bexI)
prefer 2 apply assumption
apply simp
apply(subgoal_tac "F⇩2 ≠ []")
prefer 2 apply blast
apply(rule_tac x = "n mod length F⇩2" in exI)
apply(simp add:rotate_conv_mod[symmetric])
done
text‹Thus correctness carries over to ‹pr_iso_test1›:›
corollary pr_iso_test1_corr:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F; [] ∉ set Fs⇩2;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
pr_iso_test1 Map.empty Fs⇩1 Fs⇩2 = (∃φ. is_pr_iso φ Fs⇩1 Fs⇩2)"
by(simp add: test0_conv_test1 pr_iso_test0_corr)
subsubsection‹Implementing maps by lists›
text‹The representation are lists of pairs with no repetition in the
first or second component.›
definition oneone :: "('a * 'b)list ⇒ bool" where
"oneone xys ≡ distinct(map fst xys) ∧ distinct(map snd xys)"
declare oneone_def[simp]
type_synonym
('a,'b)tester = "('a * 'b)list ⇒ ('a * 'b)list ⇒ bool"
type_synonym
('a,'b)merger = "('a * 'b)list ⇒ ('a * 'b)list ⇒ ('a * 'b)list"
primrec pr_iso_test2 :: "('a,'b)tester ⇒ ('a,'b)merger ⇒
('a * 'b)list ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"pr_iso_test2 tst mrg I [] Fs⇩2 = (Fs⇩2 = [])"
| "pr_iso_test2 tst mrg I (F⇩1#Fs⇩1) Fs⇩2 =
(∃F⇩2 ∈ set Fs⇩2. length F⇩1 = length F⇩2 ∧
(∃n < length F⇩2. let I' = zip F⇩1 (rotate n F⇩2) in
if tst I' I
then pr_iso_test2 tst mrg (mrg I' I) Fs⇩1 (remove1 F⇩2 Fs⇩2) else False))"
lemma notin_range_map_of:
"y ∉ snd ` set xys ⟹ Some y ∉ range(map_of xys)"
apply(induct xys)
apply (simp add:image_def)
apply(clarsimp split:if_splits)
done
lemma inj_on_map_upd:
"⟦ inj_on m (dom m); Some y ∉ range m ⟧ ⟹ inj_on (m(x↦y)) (dom m)"
apply(simp add:inj_on_def dom_def image_def)
apply (blast intro:sym)
done
lemma [simp]:
"distinct(map snd xys) ⟹ inj_on (map_of xys) (dom(map_of xys))"
apply(induct xys)
apply simp
apply (simp add: notin_range_map_of inj_on_map_upd)
apply(clarsimp simp add:image_def)
apply(drule map_of_SomeD)
apply fastforce
done
lemma lem: "Ball (set xs) P ⟹ Ball (set (remove1 x xs)) P = True"
by(induct xs) simp_all
lemma pr_iso_test2_conv_1:
"⋀I Fs⇩2.
⟦ ∀I I'. oneone I ⟶ oneone I' ⟶
tst I' I = (let m = map_of I; m' = map_of I'
in m ⊆⇩m m ++ m' ∧ inj_on (m++m') (dom(m++m')));
∀I I'. oneone I ⟶ oneone I' ⟶ tst I' I
⟶ map_of(mrg I' I) = map_of I ++ map_of I';
∀I I'. oneone I ∧ oneone I' ⟶ tst I' I ⟶ oneone (mrg I' I);
oneone I;
∀F ∈ set Fs⇩1. distinct F; ∀F ∈ set Fs⇩2. distinct F ⟧ ⟹
pr_iso_test2 tst mrg I Fs⇩1 Fs⇩2 = pr_iso_test1 (map_of I) Fs⇩1 Fs⇩2"
apply(induct Fs⇩1)
apply simp
apply(simp add:Let_def lem inj_on_map_of_zip del: mod_less cong: conj_cong)
done
text‹A simple implementation›
definition compat :: "('a,'b)tester" where
"compat I I' ==
∀(x,y) ∈ set I. ∀(x',y') ∈ set I'. (x = x') = (y = y')"
lemma image_map_upd:
"x ∉ dom m ⟹ m(x↦y) ` A = m ` (A-{x}) ∪ (if x ∈ A then {Some y} else {})"
by(auto simp:image_def dom_def)
lemma image_map_of_conv_Image:
"⋀A. ⟦ distinct(map fst xys) ⟧
⟹ map_of xys ` A = Some ` (set xys `` A) ∪ (if A ⊆ fst ` set xys then {} else {None})"
supply image_cong_simp [cong del]
apply (induct xys)
apply (simp add:image_def Image_def Collect_conv_if)
apply (simp add:image_map_upd dom_map_of_conv_image_fst)
apply(erule thin_rl)
apply (clarsimp simp:image_def Image_def)
apply((rule conjI, clarify)+, fastforce)
apply fastforce
apply(clarify)
apply((rule conjI, clarify)+, fastforce)
apply fastforce
apply fastforce
apply fastforce
done
lemma [simp]: "m++m' ` (dom m' - A) = m' ` (dom m' - A)"
apply(clarsimp simp add:map_add_def image_def dom_def inj_on_def split:option.splits)
apply auto
apply (blast intro:sym)
apply (blast intro:sym)
apply (rule_tac x = xa in bexI)
prefer 2 apply blast
apply simp
done
declare Diff_subset [iff]
lemma compat_correct:
"⟦ oneone I; oneone I' ⟧ ⟹
compat I' I = (let m = map_of I; m' = map_of I'
in m ⊆⇩m m ++ m' ∧ inj_on (m++m') (dom(m++m')))"
apply(simp add: compat_def Let_def map_le_iff_map_add_commute)
apply(rule iffI)
apply(rule context_conjI)
apply(rule ext)
apply (fastforce simp add:map_add_def split:option.split)
apply(simp add:inj_on_Un)
apply(drule sym)
apply simp
apply(simp add: dom_map_of_conv_image_fst image_map_of_conv_Image)
apply(simp add: image_def Image_def)
apply fastforce
apply clarsimp
apply(rename_tac a b aa ba)
apply(rule iffI)
apply (clarsimp simp: fun_eq_iff)
apply(erule_tac x = aa in allE)
apply (simp add:map_add_def)
apply (clarsimp simp:dom_map_of_conv_image_fst)
apply(simp (no_asm_use) add:inj_on_def)
apply(drule_tac x = a in bspec)
apply force
apply(drule_tac x = aa in bspec)
apply force
apply(erule mp)
apply simp
apply(drule sym)
apply simp
done
corollary compat_corr:
"∀I I'. oneone I ⟶ oneone I' ⟶
compat I' I = (let m = map_of I; m' = map_of I'
in m ⊆⇩m m ++ m' ∧ inj_on (m++m') (dom(m++m')))"
by(simp add: compat_correct)
definition merge0 :: "('a,'b)merger" where
"merge0 I' I ≡ [xy ← I'. fst xy ∉ fst ` set I] @ I"
lemma help1:
"distinct(map fst xys) ⟹ map_of (filter P xys) =
map_of xys |` {x. ∃y. (x,y) ∈ set xys ∧ P(x,y)}"
apply(induct xys)
apply simp
apply(rule ext)
apply (simp add:restrict_map_def)
apply force
done
lemma merge0_correct:
"∀I I'. oneone I ⟶ oneone I' ⟶ compat I' I
⟶ map_of(merge0 I' I) = map_of I ++ map_of I'"
apply(simp add:compat_def merge0_def help1 fun_eq_iff map_add_def restrict_map_def split:option.split)
apply fastforce
done
lemma merge0_inv:
"∀I I'. oneone I ∧ oneone I' ⟶ compat I' I ⟶ oneone (merge0 I' I)"
apply(auto simp add:merge0_def distinct_map compat_def split_def)
apply(blast intro:subset_inj_on)+
done
corollary pr_iso_test2_corr:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F; [] ∉ set Fs⇩2;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
pr_iso_test2 compat merge0 [] Fs⇩1 Fs⇩2 = (∃φ. is_pr_iso φ Fs⇩1 Fs⇩2)"
by(simp add: pr_iso_test2_conv_1[OF compat_corr merge0_correct merge0_inv]
pr_iso_test1_corr)
text‹Implementing merge as a recursive function:›
primrec merge :: "('a,'b)merger" where
"merge [] I = I"
| "merge (xy#xys) I = (let (x,y) = xy in
if ∀ (x',y') ∈ set I. x ≠ x' then xy # merge xys I else merge xys I)"
lemma merge_conv_merge0: "merge I' I = merge0 I' I"
apply(induct I')
apply(simp add:merge0_def)
apply(force simp add:Let_def list_all_iff merge0_def)
done
primrec pr_iso_test_rec :: "('a * 'b)list ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"pr_iso_test_rec I [] Fs⇩2 = (Fs⇩2 = [])"
| "pr_iso_test_rec I (F⇩1#Fs⇩1) Fs⇩2 =
(∃ F⇩2 ∈ set Fs⇩2. length F⇩1 = length F⇩2 ∧
(∃n < length F⇩2. let I' = zip F⇩1 (rotate n F⇩2) in
compat I' I ∧ pr_iso_test_rec (merge I' I) Fs⇩1 (remove1 F⇩2 Fs⇩2)))"
lemma pr_iso_test_rec_conv_2:
"⋀I Fs⇩2. pr_iso_test_rec I Fs⇩1 Fs⇩2 = pr_iso_test2 compat merge0 I Fs⇩1 Fs⇩2"
apply(induct Fs⇩1)
apply simp
apply(auto simp: merge_conv_merge0 list_ex_iff Bex_def Let_def)
done
corollary pr_iso_test_rec_corr:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F; [] ∉ set Fs⇩2;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
pr_iso_test_rec [] Fs⇩1 Fs⇩2 = (∃φ. is_pr_iso φ Fs⇩1 Fs⇩2)"
by(simp add: pr_iso_test_rec_conv_2 pr_iso_test2_corr)
definition pr_iso_test :: "'a fgraph ⇒ 'b fgraph ⇒ bool" where
"pr_iso_test Fs⇩1 Fs⇩2 = pr_iso_test_rec [] Fs⇩1 Fs⇩2"
corollary pr_iso_test_correct:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F; [] ∉ set Fs⇩2;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
pr_iso_test Fs⇩1 Fs⇩2 = (∃φ. is_pr_iso φ Fs⇩1 Fs⇩2)"
apply(simp add:pr_iso_test_def pr_iso_test_rec_corr)
done
subsubsection‹`Improper' Isomorphisms›
definition is_Iso :: "('a ⇒ 'b) ⇒ 'a Fgraph ⇒ 'b Fgraph ⇒ bool" where
"is_Iso φ Fs⇩1 Fs⇩2 ≡ is_pr_Iso φ Fs⇩1 Fs⇩2 ∨ is_pr_Iso φ Fs⇩1 (rev ` Fs⇩2)"
definition is_iso :: "('a ⇒ 'b) ⇒ 'a fgraph ⇒ 'b fgraph ⇒ bool" where
"is_iso φ Fs⇩1 Fs⇩2 ≡ is_Iso φ (set Fs⇩1) (set Fs⇩2)"
definition iso_fgraph :: "'a fgraph ⇒ 'a fgraph ⇒ bool" (infix "≃" 60) where
"g⇩1 ≃ g⇩2 ≡ ∃φ. is_iso φ g⇩1 g⇩2"
lemma iso_fgraph_trans: assumes "f ≃ (g::'a fgraph)" and "g ≃ h" shows "f ≃ h"
proof-
{ fix φ φ' assume "is_pr_Hom φ (set f) (set g)" "inj_on φ (⋃F∈set f. set F)"
"is_pr_Hom φ' (set g) (set h)" "inj_on φ' (⋃F∈set g. set F)"
hence "is_pr_Hom (φ' ∘ φ) (set f) (set h) ∧
inj_on (φ' ∘ φ) (⋃F∈set f. set F)"
by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
} moreover
{ fix φ φ' assume "is_pr_Hom φ (set f) (set g)" "inj_on φ (⋃F∈set f. set F)"
"is_pr_Hom φ' (set g) (rev ` set h)" "inj_on φ' (⋃F∈set g. set F)"
hence "is_pr_Hom (φ' ∘ φ) (set f) (rev ` set h) ∧
inj_on (φ' ∘ φ) (⋃F∈set f. set F)"
by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
} moreover
{ fix φ φ' assume "is_pr_Hom φ (set f) (rev ` set g)" "inj_on φ (⋃F∈set f. set F)"
"is_pr_Hom φ' (set g) (set h)" "inj_on φ' (⋃F∈set g. set F)"
with this(3)[THEN is_pr_Hom_rev]
have "is_pr_Hom (φ' ∘ φ) (set f) (rev ` set h) ∧
inj_on (φ' ∘ φ) (⋃F∈set f. set F)"
by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
} moreover
{ fix φ φ' assume "is_pr_Hom φ (set f) (rev ` set g)" "inj_on φ (⋃F∈set f. set F)"
"is_pr_Hom φ' (set g) (rev ` set h)" "inj_on φ' (⋃F∈set g. set F)"
with this(3)[THEN is_pr_Hom_rev]
have "is_pr_Hom (φ' ∘ φ) (set f) (set h) ∧
inj_on (φ' ∘ φ) (⋃F∈set f. set F)"
by(simp add: is_pr_Hom_trans comp_inj_on pr_Hom_pres_nodes)
} ultimately show ?thesis using assms
by(simp add: iso_fgraph_def is_iso_def is_Iso_def is_pr_Iso_def) blast
qed
definition iso_test :: "'a fgraph ⇒ 'b fgraph ⇒ bool" where
"iso_test g⇩1 g⇩2 ⟷ pr_iso_test g⇩1 g⇩2 ∨ pr_iso_test g⇩1 (map rev g⇩2)"
theorem iso_correct:
"⟦ ∀F∈set Fs⇩1. distinct F; ∀F∈set Fs⇩2. distinct F; [] ∉ set Fs⇩2;
distinct Fs⇩1; inj_on (λxs.{xs}//{≅}) (set Fs⇩1);
distinct Fs⇩2; inj_on (λxs.{xs}//{≅}) (set Fs⇩2) ⟧ ⟹
iso_test Fs⇩1 Fs⇩2 = (Fs⇩1 ≃ Fs⇩2)"
apply(simp add:iso_test_def pr_iso_test_correct iso_fgraph_def)
apply(subst pr_iso_test_correct)
apply simp
apply simp
apply (simp add:image_def)
apply simp
apply simp
apply (simp add:distinct_map)
apply (simp add:inj_on_image_iff)
apply(simp add:is_iso_def is_Iso_def is_pr_iso_def)
apply blast
done
lemma iso_fgraph_refl[iff]: "g ≃ g"
apply(simp add: iso_fgraph_def)
apply(rule_tac x = "id" in exI)
apply(simp add: is_iso_def is_Iso_def is_pr_Iso_def is_pr_Hom_def id_def)
done
subsection‹Elementhood and containment modulo›
interpretation qle_gr: quasi_order "(≃)"
proof qed (auto intro:iso_fgraph_trans)
abbreviation qle_gr_in :: "'a fgraph ⇒ 'a fgraph set ⇒ bool" (infix "∈⇩≃" 60)
where "x ∈⇩≃ M ≡ qle_gr.in_qle x M"
abbreviation qle_gr_sub :: "'a fgraph set ⇒ 'a fgraph set ⇒ bool" (infix "⊆⇩≃" 60)
where "x ⊆⇩≃ M ≡ qle_gr.subseteq_qle x M"
abbreviation qle_gr_eq :: "'a fgraph set ⇒ 'a fgraph set ⇒ bool" (infix "=⇩≃" 60)
where "x =⇩≃ M ≡ qle_gr.seteq_qle x M"
end
Theory Rotation
section ‹More Rotation›
theory Rotation
imports ListAux PlaneGraphIso
begin
definition rotate_to :: "'a list ⇒ 'a ⇒ 'a list" where
"rotate_to vs v ≡ v # snd (splitAt v vs) @ fst (splitAt v vs)"
definition rotate_min :: "nat list ⇒ nat list" where
"rotate_min vs ≡ rotate_to vs (min_list vs)"
lemma cong_rotate_to:
"x ∈ set xs ⟹ xs ≅ rotate_to xs x"
proof -
assume x: "x ∈ set xs"
hence ls1: "xs = fst (splitAt x xs) @ x # snd (splitAt x xs)" by (auto dest: splitAt_ram)
define i where "i = length(fst(splitAt x xs))"
hence "i < length((fst(splitAt x xs)) @ [x] @ snd(splitAt x xs))" by auto
with ls1 have i_len: "i < length xs" by auto
hence ls2: "xs = take i xs @ xs!i # drop (Suc i) xs" by (auto intro: id_take_nth_drop)
from i_len have "length (take i xs) = i" by auto
with i_def have len_eq: "length(take i xs) = length(fst(splitAt x xs))" by auto
moreover
from ls1 ls2 have eq: "take i xs @ xs!i # drop (Suc i) xs = fst(splitAt x xs) @ x # snd(splitAt x xs)" by simp
ultimately have
v_simp: "x = xs!i" and
take_i: "fst(splitAt x xs) = take i xs" and
drop_i': "snd(splitAt x xs) = drop (Suc i) xs" by auto
from i_len have ls3: "xs = take i xs @ drop i xs" by auto
with take_i have eq: "xs = fst(splitAt x xs) @ drop i xs" by auto
with ls1 have "fst(splitAt x xs) @ drop i xs = fst(splitAt x xs) @ x # snd(splitAt x xs)" by auto
then have drop_i: "drop i xs = x # snd(splitAt x xs)" by auto
have "rotate i xs = drop (i mod length xs) xs @ take (i mod length xs) xs" by (rule rotate_drop_take)
with i_len have "rotate i xs = drop i xs @ take i xs" by auto
with take_i drop_i have "rotate i xs = (x # snd(splitAt x xs)) @ fst(splitAt x xs)" by auto
thus ?thesis apply (auto simp: congs_def rotate_to_def) apply (rule exI) apply (rule sym) .
qed
lemma face_cong_if_norm_eq:
"⟦ rotate_min xs = rotate_min ys; xs ≠ []; ys ≠ [] ⟧ ⟹ xs ≅ ys"
apply(simp add:rotate_min_def)
apply(subgoal_tac "xs ≅ rotate_to xs (Min (set xs))")
apply(subgoal_tac "ys ≅ rotate_to ys (Min (set ys))")
apply(simp) apply(blast intro:congs_sym congs_trans)
apply(simp add: cong_rotate_to)
apply(drule sym)
apply(simp add: cong_rotate_to)
done
lemma norm_eq_if_face_cong:
"⟦ xs ≅ ys; distinct xs; xs ≠ [] ⟧ ⟹ rotate_min xs = rotate_min ys"
by(auto simp:congs_def rotate_min_def rotate_to_def
splitAt_rotate_pair_conv insert_absorb)
lemma norm_eq_iff_face_cong:
"⟦ distinct xs; xs ≠ []; ys ≠ [] ⟧ ⟹
(rotate_min xs = rotate_min ys) = (xs ≅ ys)"
by(blast intro: face_cong_if_norm_eq norm_eq_if_face_cong)
lemma inj_on_rotate_min_iff:
assumes "∀vs ∈ A. distinct vs" "[] ∉ A"
shows "inj_on rotate_min A = inj_on (λvs. {vs}//{≅}) A"
proof -
{ fix xs ys assume xs: "xs ∈ A" and ys : "ys ∈ A"
hence "xs ≠ [] ∧ ys ≠ []" using assms(2) by blast
hence "(rotate_min xs = rotate_min ys) = (xs ≅ ys)"
using xs assms(1)
by(simp add: singleton_list_cong_eq_iff norm_eq_iff_face_cong)
} thus ?thesis by(simp add:inj_on_def)
qed
end
Theory Graph
section ‹Graph›
theory Graph
imports Rotation
begin
syntax
"_UNION1" :: "pttrns ⇒ 'b set ⇒ 'b set" ("(3⋃(‹unbreakable›⇘_⇙)/ _)" [0, 10] 10)
"_INTER1" :: "pttrns ⇒ 'b set ⇒ 'b set" ("(3⋂(‹unbreakable›⇘_⇙)/ _)" [0, 10] 10)
"_UNION" :: "pttrn ⇒ 'a set ⇒ 'b set ⇒ 'b set" ("(3⋃(‹unbreakable›⇘_∈_⇙)/ _)" [0, 0, 10] 10)
"_INTER" :: "pttrn ⇒ 'a set ⇒ 'b set ⇒ 'b set" ("(3⋂(‹unbreakable›⇘_∈_⇙)/ _)" [0, 0, 10] 10)
subsection‹Notation›
type_synonym vertex = "nat"
consts
vertices :: "'a ⇒ vertex list"
edges :: "'a ⇒ (vertex × vertex) set" ("ℰ")
abbreviation vertices_set :: "'a ⇒ vertex set" ("𝒱") where
"𝒱 f ≡ set (vertices f)"
subsection ‹Faces›
text ‹
We represent faces by (distinct) lists of vertices and a face type.
›
datatype facetype = Final | Nonfinal
datatype face = Face "(vertex list)" facetype
consts final :: "'a ⇒ bool"
consts type :: "'a ⇒ facetype"
overloading
final_face ≡ "final :: face ⇒ bool"
type_face ≡ "type :: face ⇒ facetype"
vertices_face ≡ "vertices :: face ⇒ vertex list"
cong_face ≡ "pr_isomorphic :: face ⇒ face ⇒ bool"
begin
primrec final_face where
"final (Face vs f) = (case f of Final ⇒ True | Nonfinal ⇒ False)"
primrec type_face where
"type (Face vs f) = f"
primrec vertices_face where
"vertices (Face vs f) = vs"
definition cong_face :: "face ⇒ face ⇒ bool"
where "(f⇩1 :: face) ≅ f⇩2 ≡ vertices f⇩1 ≅ vertices f⇩2"
end
text ‹The following operation makes a face final.›
definition setFinal :: "face ⇒ face" where
"setFinal f ≡ Face (vertices f) Final"
text ‹The function ‹nextVertex› (written ‹f ∙ v›) is based on
‹nextElem›, that returns the successor of an element in a list.›
primrec nextElem :: "'a list ⇒ 'a ⇒ 'a ⇒ 'a" where
"nextElem [] b x = b"
|"nextElem (a#as) b x =
(if x=a then (case as of [] ⇒ b | (a'#as') ⇒ a') else nextElem as b x)"
definition nextVertex :: "face ⇒ vertex ⇒ vertex" ("_ ∙" [999]) where
"f ∙ ≡ let vs = vertices f in nextElem vs (hd vs)"
text ‹‹nextVertices› is $n$-fold application of
‹nextvertex›.›
definition nextVertices :: "face ⇒ nat ⇒ vertex ⇒ vertex" ("_⇗_⇖ ∙ _" [100, 0, 100]) where
"f⇗n⇖ ∙ v ≡ (f ∙ ^^ n) v"
lemma nextV2: "f⇗2⇖∙v = f∙ (f∙ v)"
by (simp add: nextVertices_def eval_nat_numeral)
overloading edges_face ≡ "edges :: face ⇒ (vertex × vertex) set"
begin
definition "ℰ f ≡ {(a, f ∙ a)|a. a ∈ 𝒱 f}"
end
consts op :: "'a ⇒ 'a" ("_⇗op⇖" [1000] 999)
overloading op_vertices ≡ "Graph.op :: vertex list ⇒ vertex list"
begin
definition "(vs::vertex list)⇗op⇖ ≡ rev vs"
end
overloading op_graph ≡ "Graph.op :: face ⇒ face"
begin
primrec op_graph where "(Face vs f)⇗op⇖ = Face (rev vs) f"
end
lemma [simp]: "vertices ((f::face)⇗op⇖) = (vertices f)⇗op⇖"
by (induct f) (simp add: op_vertices_def)
lemma [simp]: "xs ≠ [] ⟹ hd (rev xs)= last xs"
by(induct xs) simp_all
definition prevVertex :: "face ⇒ vertex ⇒ vertex" ("_⇗-1⇖ ∙" [100]) where
"f⇗-1⇖ ∙ v ≡ (let vs = vertices f in nextElem (rev vs) (last vs) v)"
abbreviation
triangle :: "face ⇒ bool" where
"triangle f == |vertices f| = 3"
subsection ‹Graphs›
datatype graph = Graph "(face list)" "nat" "face list list" "nat list"
primrec faces :: "graph ⇒ face list" where
"faces (Graph fs n f h) = fs"
abbreviation
Faces :: "graph ⇒ face set" ("ℱ") where
"ℱ g == set(faces g)"
primrec countVertices :: "graph ⇒ nat" where
"countVertices (Graph fs n f h) = n"
overloading
vertices_graph ≡ "vertices :: graph ⇒ vertex list"
begin
primrec vertices_graph where "vertices (Graph fs n f h) = [0 ..< n]"
end
lemma vertices_graph: "vertices g = [0 ..< countVertices g]"
by (induct g) simp
lemma in_vertices_graph:
"v ∈ set (vertices g) = (v < countVertices g)"
by (simp add:vertices_graph)
lemma len_vertices_graph:
"|vertices g| = countVertices g"
by (simp add:vertices_graph)
primrec faceListAt :: "graph ⇒ face list list" where
"faceListAt (Graph fs n f h) = f"
definition facesAt :: "graph ⇒ vertex ⇒ face list" where
"facesAt g v ≡ faceListAt g ! v "
primrec heights :: "graph ⇒ nat list" where
"heights (Graph fs n f h) = h"
definition height :: "graph ⇒ vertex ⇒ nat" where
"height g v ≡ heights g ! v"
definition graph :: "nat ⇒ graph" where
"graph n ≡
(let vs = [0 ..< n];
fs = [ Face vs Final, Face (rev vs) Nonfinal]
in (Graph fs n (replicate n fs) (replicate n 0)))"
subsection‹Operations on graphs›
text ‹final graph, final / nonfinal faces›
definition finals :: "graph ⇒ face list" where
"finals g ≡ [f ← faces g. final f]"
definition nonFinals :: "graph ⇒ face list" where
"nonFinals g ≡ [f ← faces g. ¬ final f]"
definition countNonFinals :: "graph ⇒ nat" where
"countNonFinals g ≡ |nonFinals g|"
overloading finalGraph ≡ "final :: graph ⇒ bool"
begin
definition "finalGraph g ≡ (nonFinals g = [])"
end
lemma finalGraph_faces[simp]: "final g ⟹ finals g = faces g"
by (simp add: finalGraph_def finals_def nonFinals_def filter_compl1)
lemma finalGraph_face: "final g ⟹ f ∈ set (faces g) ⟹ final f"
by (simp only: finalGraph_faces[symmetric]) (simp add: finals_def)
definition finalVertex :: "graph ⇒ vertex ⇒ bool" where
"finalVertex g v ≡ ∀f ∈ set(facesAt g v). final f"
lemma finalVertex_final_face[dest]:
"finalVertex g v ⟹ f ∈ set (facesAt g v) ⟹ final f"
by (auto simp add: finalVertex_def)
text ‹counting faces›
definition degree :: "graph ⇒ vertex ⇒ nat" where
"degree g v ≡ |facesAt g v|"
definition tri :: "graph ⇒ vertex ⇒ nat" where
"tri g v ≡ |[f ← facesAt g v. final f ∧ |vertices f| = 3]|"
definition quad :: "graph ⇒ vertex ⇒ nat" where
"quad g v ≡ |[f ← facesAt g v. final f ∧ |vertices f| = 4]|"
definition except :: "graph ⇒ vertex ⇒ nat" where
"except g v ≡ |[f ← facesAt g v. final f ∧ 5 ≤ |vertices f| ]|"
definition vertextype :: "graph ⇒ vertex ⇒ nat × nat × nat" where
"vertextype g v ≡ (tri g v, quad g v, except g v)"
lemma[simp]: "0 ≤ tri g v" by (simp add: tri_def)
lemma[simp]: "0 ≤ quad g v" by (simp add: quad_def)
lemma[simp]: "0 ≤ except g v" by (simp add: except_def)
definition exceptionalVertex :: "graph ⇒ vertex ⇒ bool" where
"exceptionalVertex g v ≡ except g v ≠ 0"
definition noExceptionals :: "graph ⇒ vertex set ⇒ bool" where
"noExceptionals g V ≡ (∀v ∈ V. ¬ exceptionalVertex g v)"
text ‹An edge $(a,b)$ is contained in face f,
$b$ is the successor of $a$ in $f$.›
overloading edges_graph ≡ "edges :: graph ⇒ (vertex × vertex) set"
begin
definition "ℰ (g::graph) ≡ ⋃⇘f ∈ ℱ g⇙ edges f"
end
definition neighbors :: "graph ⇒ vertex ⇒ vertex list" where
"neighbors g v ≡ [f∙v. f ← facesAt g v]"
subsection ‹Navigation in graphs›
text ‹
The function $s'$ permutating the faces at a vertex,
is implemeted by the function ‹nextFace›
›
definition nextFace :: "graph × vertex ⇒ face ⇒ face" ("_ ∙") where
nextFace_def_aux: "p ∙ ≡ λf. (let (g,v) = p; fs = (facesAt g v) in
(case fs of [] ⇒ f
| g#gs ⇒ nextElem fs (hd fs) f))"
definition directedLength :: "face ⇒ vertex ⇒ vertex ⇒ nat" where
"directedLength f a b ≡
if a = b then 0 else |(between (vertices f) a b)| + 1"
subsection ‹Code generator setup›
definition final_face :: "face ⇒ bool" where
final_face_code_def: "final_face = final"
declare final_face_code_def [symmetric, code_unfold]
lemma final_face_code [code]:
"final_face (Face vs Final) ⟷ True"
"final_face (Face vs Nonfinal) ⟷ False"
by (simp_all add: final_face_code_def)
definition final_graph :: "graph ⇒ bool" where
final_graph_code_def: "final_graph = final"
declare final_graph_code_def [symmetric, code_unfold]
lemma final_graph_code [code]: "final_graph g = List.null (nonFinals g)"
unfolding final_graph_code_def finalGraph_def null_def ..
definition vertices_face :: "face ⇒ vertex list" where
vertices_face_code_def: "vertices_face = vertices"
declare vertices_face_code_def [symmetric, code_unfold]
lemma vertices_face_code [code]: "vertices_face (Face vs f) = vs"
unfolding vertices_face_code_def by simp
definition vertices_graph :: "graph ⇒ vertex list" where
vertices_graph_code_def: "vertices_graph = vertices"
declare vertices_graph_code_def [symmetric, code_unfold]
lemma vertices_graph_code [code]:
"vertices_graph (Graph fs n f h) = [0 ..< n]"
unfolding vertices_graph_code_def by simp
end
Theory IArray_Syntax
section ‹Syntax for operations on immutable arrays›
theory IArray_Syntax
imports Main "HOL-Library.IArray"
begin
subsection ‹Tabulation›
definition tabulate :: "nat ⇒ (nat ⇒ 'a) ⇒ 'a iarray"
where
"tabulate n f = IArray.of_fun f n"
definition tabulate2 :: "nat ⇒ nat ⇒ (nat ⇒ nat ⇒ 'a) ⇒ 'a iarray iarray"
where
"tabulate2 m n f = IArray.of_fun (λi .IArray.of_fun (f i) n) m "
definition tabulate3 :: "nat ⇒ nat ⇒ nat ⇒
(nat ⇒ nat ⇒ nat ⇒ 'a) ⇒ 'a iarray iarray iarray" where
"tabulate3 l m n f ≡ IArray.of_fun (λi. IArray.of_fun (λj. IArray.of_fun (λk. f i j k) n) m) l"
syntax
"_tabulate" :: "'a ⇒ pttrn ⇒ nat ⇒ 'a iarray" ("(⟦_. _ < _⟧)")
"_tabulate2" :: "'a ⇒ pttrn ⇒ nat ⇒ pttrn ⇒ nat ⇒ 'a iarray"
("(⟦_. _ < _, _ < _⟧)")
"_tabulate3" :: "'a ⇒ pttrn ⇒ nat ⇒ pttrn ⇒ nat ⇒ pttrn ⇒ nat ⇒ 'a iarray"
("(⟦_. _ < _, _ < _, _ < _ ⟧)")
translations
"⟦f. x < n⟧" == "CONST tabulate n (λx. f)"
"⟦f. x < m, y < n⟧" == "CONST tabulate2 m n (λx y. f)"
"⟦f. x < l, y < m, z < n⟧" == "CONST tabulate3 l m n (λx y z. f)"
subsection ‹Access›
abbreviation sub1_syntax :: "'a iarray ⇒ nat ⇒ 'a" ("(_⟦_⟧)" [1000] 999)
where
"a⟦n⟧ ≡ IArray.sub a n"
abbreviation sub2_syntax :: "'a iarray iarray ⇒ nat ⇒ nat ⇒ 'a" ("(_⟦_,_⟧)" [1000] 999)
where
"as⟦m, n⟧ ≡ IArray.sub (IArray.sub as m) n"
abbreviation sub3_syntax :: "'a iarray iarray iarray ⇒ nat ⇒ nat ⇒ nat ⇒ 'a" ("(_⟦_,_,_⟧)" [1000] 999)
where
"as⟦l, m, n⟧ ≡ IArray.sub (IArray.sub (IArray.sub as l) m) n"
text ‹examples: @{term "⟦0. i < 5⟧"}, @{term "⟦i. i < 5, j < 3⟧"}›
end
Theory Enumerator
section ‹Enumerating Patches›
theory Enumerator
imports Graph IArray_Syntax
begin
text ‹
Generates an Enumeration of lists.
(See Kepler98, PartIII, section 8, p.11).
Used to construct all possible extensions of an unfinished outer
face $F$ with $outer$ vertices
by a new finished inner face with $inner$ vertices, such a fixed
edge $e$ of the outer face is also contained in the inner face.
Label the vertices of $F$ consecutively
$0, \ldots, outer-1$, with $0$ and $outer-1$ the endpoints of $e$.
Generate all lists $$[a0, \ldots, a_{inner_1}]$$ of length
$inner$,
%such that $0 = a_0 \le a_1 \ldots a_{outer - 2} < a_{outer -1}$.
such that $0 = a_0 \le a_1 \ldots a_{inner - 2} < a_{inner -1}$.
Every list represents an inner face, with vertices
$v_0, \ldots, v_{inner-1}$.
Construct the vertices $v_0, \ldots, v_{inner - 1}$ inductively:
If $i = 1$ or $a_i \not = a_{i -1}$, we set $v_i$ to the vertex
with index
$a_i$ of F. But if $a_i = a_{i -1}$, we add a new vertex $v_i$
to the planar map.
The new face is to be drawn along the edge $e$ over the face $F$.
As we run over all $inner$ and all lists
$[a0, \ldots, a_{inner_1}]$,
we run over all osibilites fro the finishe face along the edge
$e$ inside $F$.
›
text‹\paragraph{Executable enumeration of patches}›
definition enumBase :: "nat ⇒ nat list list" where
"enumBase nmax ≡ [[i]. i ← [0 ..< Suc nmax]]"
definition enumAppend :: "nat ⇒ nat list list ⇒ nat list list" where
"enumAppend nmax iss ≡ ⨆⇘is∈iss⇙ [is @ [n]. n ← [last is ..< Suc nmax]]"
definition enumerator :: "nat ⇒ nat ⇒ nat list list" where
"enumerator inner outer ≡
let nmax = outer - 2; k = inner - 3 in
[[0] @ is @ [outer - 1]. is ← (enumAppend nmax ^^ k) (enumBase nmax)]"
definition enumTab :: "nat list list iarray iarray" where
"enumTab ≡ ⟦ enumerator inner outer. inner < 9, outer < 9 ⟧"
definition enum :: "nat ⇒ nat ⇒ nat list list" where
"enum inner outer ≡ if inner < 9 ∧ outer < 9 then enumTab⟦inner,outer⟧
else enumerator inner outer"
text‹\paragraph{Conversion to list of vertices}›
primrec hideDupsRec :: "'a ⇒ 'a list ⇒ 'a option list" where
"hideDupsRec a [] = []"
| "hideDupsRec a (b#bs) =
(if a = b then None # hideDupsRec b bs
else Some b # hideDupsRec b bs)"
primrec hideDups :: "'a list ⇒ 'a option list" where
"hideDups [] = []"
| "hideDups (b#bs) = Some b # hideDupsRec b bs"
definition indexToVertexList :: "face ⇒ vertex ⇒ nat list ⇒ vertex option list" where
"indexToVertexList f v is ≡ hideDups [f⇗k⇖∙v. k ← is]"
end
Theory FaceDivision
section‹Subdividing a Face›
theory FaceDivision
imports Graph
begin
definition split_face :: "face ⇒ vertex ⇒ vertex ⇒ vertex list ⇒ face × face" where
"split_face f ram⇩1 ram⇩2 newVs ≡ let vs = vertices f;
f⇩1 = [ram⇩1] @ between vs ram⇩1 ram⇩2 @ [ram⇩2];
f⇩2 = [ram⇩2] @ between vs ram⇩2 ram⇩1 @ [ram⇩1] in
(Face (rev newVs @ f⇩1) Nonfinal,
Face (f⇩2 @ newVs) Nonfinal)"
definition replacefacesAt :: "nat list ⇒ face ⇒ face list ⇒ face list list ⇒ face list list" where
"replacefacesAt ns f fs F ≡ mapAt ns (replace f fs) F"
definition makeFaceFinalFaceList :: "face ⇒ face list ⇒ face list" where
"makeFaceFinalFaceList f fs ≡ replace f [setFinal f] fs"
definition makeFaceFinal :: "face ⇒ graph ⇒ graph" where
"makeFaceFinal f g ≡
Graph (makeFaceFinalFaceList f (faces g))
(countVertices g)
[makeFaceFinalFaceList f fs. fs ← faceListAt g]
(heights g)"
definition heightsNewVertices :: "nat ⇒ nat ⇒ nat ⇒ nat list" where
"heightsNewVertices h⇩1 h⇩2 n ≡ [min (h⇩1 + i + 1) (h⇩2 + n - i). i ← [0 ..< n]]"
definition splitFace
:: "graph ⇒ vertex ⇒ vertex ⇒ face ⇒ vertex list ⇒ face × face × graph" where
"splitFace g ram⇩1 ram⇩2 oldF newVs ≡
let fs = faces g;
n = countVertices g;
Fs = faceListAt g;
h = heights g;
vs⇩1 = between (vertices oldF) ram⇩1 ram⇩2;
vs⇩2 = between (vertices oldF) ram⇩2 ram⇩1;
(f⇩1, f⇩2) = split_face oldF ram⇩1 ram⇩2 newVs;
Fs = replacefacesAt vs⇩1 oldF [f⇩1] Fs;
Fs = replacefacesAt vs⇩2 oldF [f⇩2] Fs;
Fs = replacefacesAt [ram⇩1] oldF [f⇩2, f⇩1] Fs;
Fs = replacefacesAt [ram⇩2] oldF [f⇩1, f⇩2] Fs;
Fs = Fs @ replicate |newVs| [f⇩1, f⇩2] in
(f⇩1, f⇩2, Graph ((replace oldF [f⇩2] fs)@ [f⇩1])
(n + |newVs| )
Fs
(h @ heightsNewVertices (h!ram⇩1)(h!ram⇩2) |newVs| ))"
primrec subdivFace' :: "graph ⇒ face ⇒ vertex ⇒ nat ⇒ vertex option list ⇒ graph" where
"subdivFace' g f u n [] = makeFaceFinal f g"
| "subdivFace' g f u n (vo#vos) =
(case vo of None ⇒ subdivFace' g f u (Suc n) vos
| (Some v) ⇒
if f∙u = v ∧ n = 0
then subdivFace' g f v 0 vos
else let ws = [countVertices g ..< countVertices g + n];
(f⇩1, f⇩2, g') = splitFace g u v f ws in
subdivFace' g' f⇩2 v 0 vos)"
definition subdivFace :: "graph ⇒ face ⇒ vertex option list ⇒ graph" where
"subdivFace g f vos ≡ subdivFace' g f (the(hd vos)) 0 (tl vos)"
end
Theory RTranCl
section ‹Transitive Closure of Successor List Function›
theory RTranCl
imports Main
begin
text‹The reflexive transitive closure of a relation induced by a
function of type @{typ"'a ⇒ 'a list"}. Instead of defining the closure
again it would have been simpler to take @{term"{(x,y) . y ∈ set(f x)}⇧*"}.›
abbreviation (input)
in_set :: "'a ⇒ ('a ⇒ 'b list) ⇒ 'b ⇒ bool" ("_ [_]→ _" [55,0,55] 50) where
"g [succs]→ g' == g' ∈ set (succs g)"
inductive_set
RTranCl :: "('a ⇒ 'a list) ⇒ ('a * 'a) set"
and in_RTranCl :: "'a ⇒ ('a ⇒ 'a list) ⇒ 'a ⇒ bool"
("_ [_]→* _" [55,0,55] 50)
for succs :: "'a ⇒ 'a list"
where
"g [succs]→* g' ≡ (g,g') ∈ RTranCl succs"
| refl: "g [succs]→* g"
| succs: "g [succs]→ g' ⟹ g' [succs]→* g'' ⟹ g [succs]→* g''"
inductive_cases RTranCl_elim: "(h,h') : RTranCl succs"
lemma RTranCl_induct [induct set: RTranCl, consumes 1, case_names refl succs] :
"(h, h') ∈ RTranCl succs ⟹
P h ⟹
(⋀g g'. g' ∈ set (succs g) ⟹ P g ⟹ P g') ⟹
P h'"
proof -
assume s: "⋀g g'. g' ∈ set (succs g) ⟹ P g ⟹ P g'"
assume "(h, h') ∈ RTranCl succs" "P h"
then show "P h'"
proof (induct rule: RTranCl.induct)
fix g assume "P g" then show "P g" .
next
fix g g' g''
assume IH: "P g' ⟹ P g''"
assume "g' ∈ set(succs g)" "P g"
then have "P g'" by (rule s)
then show "P g''" by (rule IH)
qed
qed
definition invariant :: "('a ⇒ bool) ⇒ ('a ⇒ 'a list) ⇒ bool" where
"invariant P succs ≡ ∀g g'. g' ∈ set(succs g) ⟶ P g ⟶ P g'"
lemma invariantE:
"invariant P succs ⟹ g [succs]→ g' ⟹ P g ⟹ P g'"
by(simp add:invariant_def)
lemma inv_subset:
"invariant P f ⟹ (⋀g. P g ⟹ set(f' g) ⊆ set(f g)) ⟹ invariant P f'"
by(auto simp:invariant_def)
lemma RTranCl_inv:
"invariant P succs ⟹ (g,g') ∈ RTranCl succs ⟹ P g ⟹ P g'"
by (erule RTranCl_induct)(auto simp:invariant_def)
lemma RTranCl_subset2:
assumes a: "(s,g) : RTranCl f"
shows "(⋀g. (s,g) ∈ RTranCl f ⟹ set(f g) ⊆ set(h g)) ⟹ (s,g) : RTranCl h"
using a
proof (induct rule: RTranCl.induct)
case refl show ?case by(rule RTranCl.intros)
next
case succs thus ?case by(blast intro: RTranCl.intros)
qed
end
Theory Plane
section‹Plane Graph Enumeration›
theory Plane
imports Enumerator FaceDivision RTranCl
begin
definition maxGon :: "nat ⇒ nat" where
"maxGon p ≡ p+3"
declare maxGon_def [simp]
definition duplicateEdge :: "graph ⇒ face ⇒ vertex ⇒ vertex ⇒ bool" where
"duplicateEdge g f a b ≡
2 ≤ directedLength f a b ∧ 2 ≤ directedLength f b a ∧ b ∈ set (neighbors g a)"
primrec containsUnacceptableEdgeSnd ::
"(nat ⇒ nat ⇒ bool) ⇒ nat ⇒ nat list ⇒ bool" where
"containsUnacceptableEdgeSnd N v [] = False" |
"containsUnacceptableEdgeSnd N v (w#ws) =
(case ws of [] ⇒ False
| (w'#ws') ⇒ if v < w ∧ w < w' ∧ N w w' then True
else containsUnacceptableEdgeSnd N w ws)"
primrec containsUnacceptableEdge :: "(nat ⇒ nat ⇒ bool) ⇒ nat list ⇒ bool" where
"containsUnacceptableEdge N [] = False" |
"containsUnacceptableEdge N (v#vs) =
(case vs of [] ⇒ False
| (w#ws) ⇒ if v < w ∧ N v w then True
else containsUnacceptableEdgeSnd N v vs)"
definition containsDuplicateEdge :: "graph ⇒ face ⇒ vertex ⇒ nat list ⇒ bool" where
"containsDuplicateEdge g f v is ≡
containsUnacceptableEdge (λi j. duplicateEdge g f (f⇗i⇖∙v) (f⇗j⇖∙v)) is"
definition containsDuplicateEdge' :: "graph ⇒ face ⇒ vertex ⇒ nat list ⇒ bool" where
"containsDuplicateEdge' g f v is ≡
2 ≤ |is| ∧
((∃k < |is| - 2. let i0 = is!k; i1 = is!(k+1); i2 = is!(k+2) in
(duplicateEdge g f (f⇗i1 ⇖∙v) (f⇗i2 ⇖∙v)) ∧ (i0 < i1) ∧ (i1 < i2))
∨ (let i0 = is!0; i1 = is!1 in
(duplicateEdge g f (f⇗i0 ⇖∙v) (f⇗i1 ⇖∙v)) ∧ (i0 < i1)))"
definition generatePolygon :: "nat ⇒ vertex ⇒ face ⇒ graph ⇒ graph list" where
"generatePolygon n v f g ≡
let enumeration = enumerator n |vertices f|;
enumeration = [is ← enumeration. ¬ containsDuplicateEdge g f v is];
vertexLists = [indexToVertexList f v is. is ← enumeration] in
[subdivFace g f vs. vs ← vertexLists]"
definition next_plane0 :: "nat ⇒ graph ⇒ graph list" ("next'_plane0⇘_⇙") where
"next_plane0⇘p⇙ g ≡
if final g then []
else ⨆⇘f∈nonFinals g⇙ ⨆⇘v∈vertices f⇙ ⨆⇘i∈[3..<Suc(maxGon p)]⇙ generatePolygon i v f g"
definition Seed :: "nat ⇒ graph" ("Seed⇘_⇙") where
"Seed⇘p⇙ ≡ graph(maxGon p)"
lemma Seed_not_final[iff]: "¬ final (Seed p)"
by(simp add:Seed_def graph_def finalGraph_def nonFinals_def)
definition PlaneGraphs0 :: "graph set" where
"PlaneGraphs0 ≡ ⋃p. {g. Seed⇘p⇙ [next_plane0⇘p⇙]→* g ∧ final g}"
end
Theory Plane1
theory Plane1
imports Plane
begin
text‹This is an optimized definition of plane graphs and the one we
adopt as our point of reference. In every step only one fixed nonfinal
face (the smallest one) and one edge in that face are picked.›
definition minimalFace :: "face list ⇒ face" where
"minimalFace ≡ minimal (length ∘ vertices)"
definition minimalVertex :: "graph ⇒ face ⇒ vertex" where
"minimalVertex g f ≡ minimal (height g) (vertices f)"
definition next_plane :: "nat ⇒ graph ⇒ graph list" ("next'_plane⇘_⇙") where
"next_plane⇘p⇙ g ≡
let fs = nonFinals g in
if fs = [] then []
else let f = minimalFace fs; v = minimalVertex g f in
⨆⇘i∈[3..<Suc(maxGon p)]⇙ generatePolygon i v f g"
definition PlaneGraphsP :: "nat ⇒ graph set" ("PlaneGraphs⇘_⇙") where
"PlaneGraphs⇘p⇙ ≡ {g. Seed⇘p⇙ [next_plane⇘p⇙]→* g ∧ final g}"
definition PlaneGraphs :: "graph set" where
"PlaneGraphs ≡ ⋃p. PlaneGraphs⇘p⇙"
end
Theory GraphProps
section‹Properties of Graph Utilities›
theory GraphProps
imports Graph
begin
declare [[linarith_neq_limit = 3]]
lemma final_setFinal[iff]: "final(setFinal f)"
by (simp add:setFinal_def)
lemma eq_setFinal_iff[iff]: "(f = setFinal f) = final f"
proof (induct f)
case (Face f t)
then show ?case
by (cases t) (simp_all add: setFinal_def)
qed
lemma setFinal_eq_iff[iff]: "(setFinal f = f) = final f"
by (blast dest:sym intro:sym)
lemma distinct_vertices[iff]: "distinct(vertices(g::graph))"
by(induct g) simp
subsection‹@{const nextElem}›
lemma nextElem_append[simp]:
"y ∉ set xs ⟹ nextElem (xs @ ys) d y = nextElem ys d y"
by(induct xs) auto
lemma nextElem_cases:
"nextElem xs d x = y ⟹
x ∉ set xs ∧ y = d ∨
xs ≠ [] ∧ x = last xs ∧ y = d ∧ x ∉ set(butlast xs) ∨
(∃us vs. xs = us @ [x,y] @ vs ∧ x ∉ set us)"
apply(induct xs)
apply simp
apply simp
apply(split if_splits)
apply(simp split:list.splits)
apply(rule_tac x = "[]" in exI)
apply simp
apply simp
apply(erule disjE)
apply simp
apply(erule disjE)
apply clarsimp
apply(rule conjI)
apply clarsimp
apply (clarsimp)
apply(erule_tac x = "a#us" in allE)
apply simp
done
lemma nextElem_notin_butlast[rule_format,simp]:
"y ∉ set(butlast xs) ⟶ nextElem xs x y = x"
by(induct xs) auto
lemma nextElem_in: "nextElem xs x y : set(x#xs)"
apply (induct xs)
apply simp
apply auto
apply(clarsimp split: list.splits)
apply(clarsimp split: list.splits)
done
lemma nextElem_notin[simp]: "a ∉ set as ⟹ nextElem as c a = c"
by(erule nextElem_append[where ys = "[]", simplified])
lemma nextElem_last[simp]: assumes dist: "distinct xs"
shows "nextElem xs c (last xs) = c"
proof cases
assume "xs = []" thus ?thesis by simp
next
let ?xs = "butlast xs @ [last xs]"
assume xs: "xs ≠ []"
with dist have "distinct ?xs" by simp
hence notin: "last xs ∉ set(butlast xs)" by simp
from xs have "nextElem xs c (last xs) = nextElem ?xs c (last xs)" by simp
also from notin have "… = c" by simp
finally show ?thesis .
qed
lemma prevElem_nextElem:
assumes dist: "distinct xs" and xxs: "x : set xs"
shows "nextElem (rev xs) (last xs) (nextElem xs (hd xs) x) = x"
proof -
define x' where "x' = nextElem xs (hd xs) x"
hence nE: "nextElem xs (hd xs) x = x'" by simp
have "xs ≠ [] ∧ x = last xs ∧ x' = hd xs ∨ (∃us vs. xs = us @ [x, x'] @ vs)"
(is "?A ∨ ?B")
using nextElem_cases[OF nE] xxs by blast
thus ?thesis
proof
assume ?A
thus ?thesis using dist by(clarsimp simp:neq_Nil_conv)
next
assume ?B
then obtain us vs where [simp]: "xs = us @ [x, x'] @ vs" by blast
thus ?thesis using dist by simp
qed
qed
lemma nextElem_prevElem:
"⟦ distinct xs; x : set xs ⟧ ⟹
nextElem xs (hd xs) (nextElem (rev xs) (last xs) x) = x"
apply(cases "xs = []")
apply simp
using prevElem_nextElem[where xs = "rev xs" and x=x]
apply(simp add:hd_rev last_rev)
done
lemma nextElem_nth:
"⋀i. ⟦distinct xs; i < length xs ⟧
⟹ nextElem xs z (xs!i) = (if length xs = i+1 then z else xs!(i+1))"
apply(induct xs) apply simp
apply(case_tac i)
apply(simp split:list.split)
apply clarsimp
done
subsection ‹‹nextVertex››
lemma nextVertex_in_face'[simp]:
"vertices f ≠ [] ⟹ f ∙ v ∈ 𝒱 f"
proof -
assume f: "vertices f ≠ []"
define c where "c = nextElem (vertices f) (hd (vertices f)) v"
then have "nextElem (vertices f) (hd (vertices f)) v = c" by auto
with f show ?thesis
apply (simp add: nextVertex_def)
apply (drule_tac nextElem_cases)
apply(fastforce simp:neq_Nil_conv)
done
qed
lemma nextVertex_in_face[simp]:
"v ∈ set (vertices f) ⟹ f ∙ v ∈ 𝒱 f"
by (auto intro: nextVertex_in_face')
lemma nextVertex_prevVertex[simp]:
"⟦ distinct(vertices f); v ∈ 𝒱 f ⟧
⟹ f ∙ (f⇗-1⇖ ∙ v) = v"
by(simp add:prevVertex_def nextVertex_def nextElem_prevElem)
lemma prevVertex_nextVertex[simp]:
"⟦ distinct(vertices f); v ∈ 𝒱 f ⟧
⟹ f⇗-1⇖ ∙ (f ∙ v) = v"
by(simp add:prevVertex_def nextVertex_def prevElem_nextElem)
lemma prevVertex_in_face[simp]:
"v ∈ 𝒱 f ⟹ f⇗-1⇖ ∙ v ∈ 𝒱 f"
apply(cases "vertices f = []")
apply simp
using nextElem_in[of "rev (vertices f)" "(last (vertices f))" v]
apply (auto simp add: prevVertex_def)
done
lemma nextVertex_nth:
"⟦ distinct(vertices f); i < |vertices f| ⟧ ⟹
f ∙ (vertices f ! i) = vertices f ! ((i+1) mod |vertices f| )"
apply(cases "vertices f = []") apply simp
apply(simp add:nextVertex_def nextElem_nth hd_conv_nth)
done
subsection ‹‹ℰ››
lemma edges_face_eq:
"((a,b) ∈ ℰ (f::face)) = ((f ∙ a = b) ∧ a ∈ 𝒱 f)"
by (auto simp add: edges_face_def)
lemma edges_setFinal[simp]: "ℰ(setFinal f) = ℰ f"
by(induct f)(simp add:setFinal_def edges_face_def nextVertex_def)
lemma in_edges_in_vertices:
"(x,y) ∈ ℰ(f::face) ⟹ x ∈ 𝒱 f ∧ y ∈ 𝒱 f"
apply(simp add:edges_face_eq nextVertex_def)
apply(cut_tac xs= "vertices f" and x= "hd(vertices f)" and y=x in nextElem_in)
apply(cases "vertices f")
apply(auto)
done
lemma vertices_conv_Union_edges:
"𝒱(f::face) = (⋃(a,b)∈ℰ f. {a})"
apply(induct f)
apply(simp add:vertices_face_def edges_face_def)
apply blast
done
lemma nextVertex_in_edges: "v ∈ 𝒱 f ⟹ (v, f ∙ v) ∈ edges f"
by(auto simp:edges_face_def)
lemma prevVertex_in_edges:
"⟦distinct(vertices f); v ∈ 𝒱 f⟧ ⟹ (f⇗-1⇖ ∙ v, v) ∈ edges f"
by(simp add:edges_face_eq)
subsection ‹Triangles›
lemma vertices_triangle:
"|vertices f| = 3 ⟹ a ∈ 𝒱 f ⟹
distinct (vertices f) ⟹
𝒱 f = {a, f ∙ a, f ∙ (f ∙ a)}"
proof -
assume "|vertices f| = 3"
then obtain a1 a2 a3 where "vertices f = [a1, a2, a3]"
by (auto dest!: length3D)
moreover assume "a ∈ 𝒱 f"
moreover assume "distinct (vertices f)"
ultimately show ?thesis
by (simp, elim disjE) (auto simp add: nextVertex_def)
qed
lemma tri_next3_id:
"|vertices f| = 3 ⟹ distinct(vertices f) ⟹ v ∈ 𝒱 f
⟹ f ∙ (f ∙ (f ∙ v)) = v"
apply(subgoal_tac "∀(i::nat) < 3. (((((i+1) mod 3)+1) mod 3)+1) mod 3 = i")
apply(clarsimp simp:in_set_conv_nth nextVertex_nth)
apply(presburger)
done
lemma triangle_nextVertex_prevVertex:
"|vertices f| = 3 ⟹ a ∈ 𝒱 f ⟹
distinct (vertices f) ⟹
f ∙ (f ∙ a) = f⇗-1⇖ ∙ a"
proof -
assume "|vertices f| = 3"
then obtain a1 a2 a3 where "vertices f = [a1, a2, a3]"
by (auto dest!:length3D)
moreover assume "a ∈ 𝒱 f"
moreover assume "distinct (vertices f)"
ultimately show ?thesis
by (simp, elim disjE) (auto simp add: nextVertex_def prevVertex_def)
qed
subsection ‹Quadrilaterals›
lemma vertices_quad:
"|vertices f| = 4 ⟹ a ∈ 𝒱 f ⟹
distinct (vertices f) ⟹
𝒱 f = {a, f ∙ a, f ∙ (f ∙ a), f ∙ (f ∙ (f ∙ a))}"
proof -
assume "|vertices f| = 4"
then obtain a1 a2 a3 a4 where "vertices f = [a1, a2, a3, a4]"
by (auto dest!: length4D)
moreover assume "a ∈ 𝒱 f"
moreover assume "distinct (vertices f)"
ultimately show ?thesis
by (simp, elim disjE) (auto simp add: nextVertex_def)
qed
lemma quad_next4_id:
"⟦ |vertices f| = 4; distinct(vertices f); v ∈ 𝒱 f ⟧ ⟹
f ∙ (f ∙ (f ∙ (f ∙ v))) = v"
apply(subgoal_tac "∀(i::nat) < 4.
(((((((i+1) mod 4)+1) mod 4)+1) mod 4)+1) mod 4 = i")
apply(clarsimp simp:in_set_conv_nth nextVertex_nth)
apply(presburger)
done
lemma quad_nextVertex_prevVertex:
"|vertices f| = 4 ⟹ a ∈ 𝒱 f ⟹ distinct (vertices f) ⟹
f ∙ (f ∙ (f ∙ a)) = f⇗-1⇖ ∙ a"
proof -
assume "|vertices f| = 4"
then obtain a1 a2 a3 a4 where "vertices f = [a1, a2, a3, a4]"
by (auto dest!: length4D)
moreover assume "a ∈ 𝒱 f"
moreover assume "distinct (vertices f)"
ultimately show ?thesis
by (auto) (auto simp add: nextVertex_def prevVertex_def)
qed
lemma len_faces_sum: "|faces g| = |finals g| + |nonFinals g|"
by(simp add:finals_def nonFinals_def sum_length_filter_compl)
lemma graph_max_final_ex:
"∃f∈set (finals (graph n)). |vertices f| = n"
proof (induct "n")
case 0 then show ?case by (simp add: graph_def finals_def)
next
case (Suc n) then show ?case
by (simp add: graph_def finals_def)
qed
subsection‹No loops›
lemma distinct_no_loop2:
"⟦ distinct(vertices f); v ∈ 𝒱 f; u ∈ 𝒱 f; u ≠ v ⟧ ⟹ f ∙ v ≠ v"
apply(frule split_list[of v])
apply(clarsimp simp: nextVertex_def neq_Nil_conv hd_append
split:list.splits if_split_asm)
done
lemma distinct_no_loop1:
"⟦ distinct(vertices f); v ∈ 𝒱 f; |vertices f| > 1 ⟧ ⟹ f ∙ v ≠ v"
apply(subgoal_tac "∃u ∈ 𝒱 f. u ≠ v")
apply(blast dest:distinct_no_loop2)
apply(cases "vertices f") apply simp
apply(rename_tac a as)
apply (clarsimp simp:neq_Nil_conv)
done
subsection‹@{const between}›
lemma between_front[simp]:
"v ∉ set us ⟹ between (u # us @ v # vs) u v = us"
by(simp add:between_def split_def)
lemma between_back:
"⟦ v ∉ set us; u ∉ set vs; v ≠ u ⟧ ⟹ between (v # vs @ u # us) u v = us"
by(simp add:between_def split_def)
lemma next_between:
"⟦distinct(vertices f); v ∈ 𝒱 f; u ∈ 𝒱 f; f ∙ v ≠ u ⟧
⟹ f ∙ v ∈ set(between (vertices f) v u)"
apply(frule split_list[of u])
apply(clarsimp)
apply(erule disjE)
apply(clarsimp simp:set_between_id nextVertex_def hd_append split:list.split)
apply(erule disjE)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def nextVertex_def split:list.split)
apply(clarsimp simp:append_eq_Cons_conv)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def nextVertex_def split:list.split)
apply(clarsimp simp: hd_append)
done
lemma next_between2:
"⟦ distinct(vertices f); v ∈ 𝒱 f; u ∈ 𝒱 f; u ≠ v ⟧ ⟹
v ∈ set(between (vertices f) u (f ∙ v))"
apply(frule split_list[of u])
apply(clarsimp)
apply(erule disjE)
apply(clarsimp simp: nextVertex_def hd_append split:list.split)
apply(rule conjI)
apply(clarsimp)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def split:list.split)
apply(fastforce simp: append_eq_Cons_conv)
apply(frule split_list[of v])
apply(clarsimp simp: between_def split_def nextVertex_def split:list.splits)
apply(clarsimp simp: hd_append)
apply(erule disjE)
apply(clarsimp)
apply(frule split_list)
apply(fastforce)
done
lemma between_next_empty:
"distinct(vertices f) ⟹ between (vertices f) v (f ∙ v) = []"
apply(cases "v ∈ 𝒱 f")
apply(frule split_list)
apply(clarsimp simp:between_def split_def nextVertex_def
neq_Nil_conv hd_append split:list.split)
apply(clarsimp simp:between_def split_def nextVertex_def)
apply(cases "vertices f")
apply simp
apply simp
done
lemma unroll_between_next2:
"⟦ distinct(vertices f); u ∈ 𝒱 f; v ∈ 𝒱 f; u ≠ v ⟧ ⟹
between (vertices f) u (f ∙ v) = between (vertices f) u v @ [v]"
using split_between[OF _ _ _ next_between2]
by (simp add: between_next_empty split:if_split_asm)
lemma nextVertex_eq_lemma:
"⟦ distinct(vertices f); x ∈ 𝒱 f; y ∈ 𝒱 f; x ≠ y;
v ∈ set(x # between (vertices f) x y) ⟧ ⟹
f ∙ v = nextElem (x # between (vertices f) x y @ [y]) z v"
apply(drule split_list[of x])
apply(simp add:nextVertex_def)
apply(erule disjE)
apply(clarsimp)
apply(erule disjE)
apply(drule split_list)
apply(clarsimp simp add:between_def split_def hd_append split:list.split)
apply(fastforce simp:append_eq_Cons_conv)
apply(drule split_list)
apply(clarsimp simp add:between_def split_def hd_append split:list.split)
apply(fastforce simp:append_eq_Cons_conv)
apply(clarsimp)
apply(erule disjE)
apply(drule split_list[of y])
apply(clarsimp simp:between_def split_def)
apply(erule disjE)
apply(drule split_list[of v])
apply(fastforce simp: hd_append neq_Nil_conv split:list.split)
apply(drule split_list[of v])
apply(clarsimp)
apply(clarsimp simp: hd_append split:list.split)
apply(fastforce simp:append_eq_Cons_conv)
apply(drule split_list[of y])
apply(clarsimp simp:between_def split_def)
apply(drule split_list[of v])
apply(clarsimp)
apply(clarsimp simp: hd_append split:list.split)
apply(clarsimp simp:append_eq_Cons_conv)
apply(fastforce simp: hd_append neq_Nil_conv split:list.split)
done
end
Theory EnumeratorProps
section‹Properties of Patch Enumeration›
theory EnumeratorProps
imports Enumerator GraphProps
begin
lemma length_hideDupsRec[simp]: "⋀x. length(hideDupsRec x xs) = length xs"
by(induct xs) auto
lemma length_hideDups[simp]: "length(hideDups xs) = length xs"
by(cases xs) simp_all
lemma length_indexToVertexList[simp]:
"length(indexToVertexList x y xs) = length xs"
by(simp add:indexToVertexList_def)
definition increasing :: "('a::linorder) list ⇒ bool" where
"increasing ls ≡ ∀ x y as bs. ls = as @ x # y # bs ⟶ x ≤ y"
lemma increasing1: "⋀ as x. increasing ls ⟹ ls = as @ x # cs @ y # bs ⟹ x ≤ y"
proof (induct cs)
case Nil then show ?case
by (auto simp: increasing_def)
next
case (Cons c cs) then show ?case
apply (subgoal_tac "c ≤ y")
apply (force simp: increasing_def)
apply (rule_tac Cons) by simp_all
qed
lemma increasing2: "increasing (as@bs) ⟹ x ∈ set as ⟹ y ∈ set bs ⟹ x ≤ y"
proof-
assume n:"increasing (as@bs)" and x:"x ∈ set as" and y: "y ∈ set bs"
from x obtain as' as'' where as: "as = as' @ x # as''" by (auto simp: in_set_conv_decomp)
from y obtain bs' bs'' where bs: "bs = bs' @ y # bs''" by (auto simp: in_set_conv_decomp)
from n as bs show ?thesis
apply (auto intro!: increasing1)
apply (subgoal_tac "as' @ x # as'' @ bs' @ y # bs'' = as' @ x # (as'' @ bs') @ y # bs''")
by (assumption) auto
qed
lemma increasing3: "∀ as bs. (ls = as @ bs ⟶ (∀ x ∈ set as. ∀ y ∈ set bs. x ≤ y)) ⟹ increasing (ls)"
apply (simp add: increasing_def) apply safe
proof -
fix as bs x y
assume p: "∀asa bsa. as @ x # y # bs = asa @ bsa ⟶ (∀x∈set asa. ∀y∈set bsa. x ≤ y)"
then have p': "⋀ asa bsa. as @ x # y # bs = asa @ bsa ⟹ (∀x∈set asa. ∀y∈set bsa. x ≤ y)" by auto
then have "(∀x∈set (as @ [x]). ∀y∈set (y # bs). x ≤ y)" by (rule_tac p') auto
then show "x ≤ y" by (auto simp: increasing_def)
qed
lemma increasing4: "increasing (as@bs) ⟹ increasing as"
apply (simp add: increasing_def) apply safe by auto
lemma increasing5: "increasing (as@bs) ⟹ increasing bs"
proof -
assume nd: "increasing (as@bs)"
then have r: "⋀ x y asa bsa. (∃asa bsa. as @ bs = asa @ x # y # bsa) ⟹ x ≤ y" by (auto simp: increasing_def)
show ?thesis apply (clarsimp simp add: increasing_def)
apply (rule_tac r)
apply (rule_tac x="as @ _" in exI)
apply auto
done
qed
lemma enumBase_length: "ls ∈ set (enumBase nmax) ⟹ length ls = 1"
by (auto simp: enumBase_def)
lemma enumBase_bound: "∀y ∈ set (enumBase nmax). ∀z ∈ set y. z ≤ nmax"
by (auto simp: enumBase_def)
lemmas enumBase_simps = enumBase_length enumBase_bound
lemma enumAppend_bound: "ls ∈ set ((enumAppend nmax) lss) ⟹
∀ y ∈ set lss. ∀ z ∈ set y. z ≤ nmax ⟹ x ∈ set ls ⟹ x ≤ nmax"
by (auto simp add: enumAppend_def split: if_split_asm)
lemma enumAppend_bound_rec: "ls ∈ set (((enumAppend nmax) ^^ n) lss) ⟹
∀ y ∈ set lss. ∀ z ∈ set y. z ≤ nmax ⟹ x ∈ set ls ⟹ x ≤ nmax"
proof -
assume ls: "ls ∈ set ((enumAppend nmax ^^ n) lss)" and lss: "∀y∈set lss. ∀z∈set y. z ≤ nmax" and x: "x ∈ set ls"
have ind:"⋀ lss. ∀y∈set lss. ∀z∈set y. z ≤ nmax ⟹ ∀ y ∈ set (((enumAppend nmax) ^^ n) lss). ∀ z ∈ set y. z ≤ nmax"
proof (induct n)
case 0 then show ?case by auto
next
case (Suc n) show ?case apply (intro ballI) apply (rule enumAppend_bound) by (auto intro!: Suc)
qed
with lss have "∀ y ∈ set (((enumAppend nmax) ^^ n) lss). ∀ z ∈ set y. z ≤ nmax" apply (rule_tac ind) .
with ls x show ?thesis by auto
qed
lemma enumAppend_increase_rec:
"⋀ m as bs. ls ∈ set (((enumAppend nmax) ^^ m) (enumBase nmax)) ⟹
as @ bs = ls ⟹ ∀ x ∈ set as. ∀ y ∈ set bs. x ≤ y"
apply (induct ls rule: rev_induct) apply force apply auto apply (case_tac "m") apply simp apply (drule_tac enumBase_length)
apply (case_tac as) apply simp_all
proof -
fix x xs m as bs xa xb n
assume ih: "⋀m as bs.
⟦xs ∈ set ((enumAppend nmax ^^ m) (enumBase nmax)); as @ bs = xs⟧
⟹ ∀x∈set as. ∀xa∈set bs. x ≤ xa"
and xs:"xs @ [x] ∈ set (enumAppend nmax ((enumAppend nmax ^^ n) (enumBase nmax)))"
and asbs: "as @ bs = xs @ [x]" and xa:"xa ∈ set as" and xb: "xb ∈ set bs" and m: "m = Suc n"
from ih have ih2: "⋀ as bs x y. ⟦xs ∈ set ((enumAppend nmax ^^ n) (enumBase nmax)); as @ bs = xs; x ∈ set as; y ∈ set bs⟧
⟹ x ≤ y" by auto
from xb have "bs ≠ []" by auto
then obtain bs' b where bs': "bs = bs' @ [b]" apply (cases rule: rev_exhaust) by auto
with asbs have beq:"b = x" by auto
from bs' asbs have xs': "as @ bs' = xs" by auto
with xs have "xa ≤ x"
proof (cases "xs" rule: rev_exhaust)
case Nil with xa xs' show ?thesis by auto
next
case (snoc ys y)
have "xa ≤ y"
proof (cases "xa = y")
case True then show ?thesis by auto
next
case False
from xa xs' have "xa ∈ set xs" by auto
with False snoc have "xa ∈ set ys" by auto
with xs snoc show ?thesis
apply (rule_tac ih2)
by (auto simp: enumAppend_def)
qed
with xs snoc show "xa ≤ x" by (auto simp: enumAppend_def split:if_split_asm)
qed
then show "xa ≤ xb" apply (cases "xb = b") apply (simp add: beq)
proof (rule_tac ih2)
from xs
show "xs ∈ set ((enumAppend nmax ^^ n) (enumBase nmax))"
by (auto simp: enumAppend_def)
next
from xs' show "as @ bs' = xs" by auto
next
from xa show "xa ∈ set as" by auto
next
assume "xb ≠ b"
with xb bs' show "xb ∈ set bs'" by auto
qed
qed
lemma enumAppend_length1: "⋀ls. ls ∈ set ((enumAppend nmax ^^ n) lss) ⟹
(∀l ∈ set lss. |l| = k) ⟹ |ls| = k + n"
apply (induct n)
apply simp
by (auto simp add:enumAppend_def split: if_split_asm)
lemma enumAppend_length2: "⋀ls. ls ∈ set ((enumAppend nmax ^^ n) lss) ⟹
(⋀l. l ∈ set lss ⟹ |l| = k) ⟹ K = k + n ⟹ |ls| = K"
by (auto simp add: enumAppend_length1)
lemma enum_enumerator:
"enum i j = enumerator i j"
by(simp add: enum_def enumTab_def tabulate2_def tabulate_def)
lemma enumerator_hd: "ls ∈ set (enumerator m n) ⟹ hd ls = 0"
by (auto simp: enumerator_def split: if_split_asm)
lemma enumerator_last: "ls ∈ set (enumerator m n) ⟹ last ls = (n - 1)"
by (auto simp: enumerator_def split: if_split_asm)
lemma enumerator_length: "ls ∈ set (enumerator m n) ⟹ 2 ≤ length ls"
by (auto simp: enumerator_def split: if_split_asm)
lemmas set_enumerator_simps = enumerator_hd enumerator_last enumerator_length
lemma enumerator_not_empty[dest]: "ls ∈ set (enumerator m n) ⟹ ls ≠ []"
apply (subgoal_tac "2 ≤ length ls") apply force by (rule enumerator_length)
lemma enumerator_length2: "ls ∈ set (enumerator m n) ⟹ 2 < m ⟹ length ls = m"
proof -
assume ls:"ls ∈ set (enumerator m n)" and m: "2 < m"
define k where "k = m - 3"
with m have k: "m = k + 3" by arith
with ls have "ls ∈ set (enumerator (k+3) n)" by auto
then have "length ls = k + 3"
apply (auto simp: enumerator_def enumBase_def)
apply (erule enumAppend_length2) by auto
with k show ?thesis by simp
qed
lemma enumerator_bound: "ls ∈ set (enumerator m nmax) ⟹
0 < nmax ⟹ x ∈ set ls ⟹ x < nmax"
apply (auto simp: enumerator_def split: if_split_asm)
apply (subgoal_tac "x ≤ nmax - 2") apply arith
apply (rule_tac enumAppend_bound_rec) by(auto simp:enumBase_simps)
lemma enumerator_bound2: "ls ∈ set (enumerator m nmax) ⟹ 1 < nmax ⟹ x ∈ set (butlast ls) ⟹ x < nmax - Suc 0"
apply (auto simp: enumerator_def split: if_split_asm)
apply (subgoal_tac "x ≤ (nmax - 2)") apply arith
apply (rule_tac enumAppend_bound_rec) by(auto simp:enumBase_simps)
lemma enumerator_bound3: "ls ∈ set (enumerator m nmax) ⟹ 1 < nmax ⟹ last (butlast ls) < nmax - Suc 0"
apply (case_tac "ls" rule: rev_exhaust) apply force
apply (rule_tac enumerator_bound2) apply assumption
apply auto
apply (case_tac "ys" rule: rev_exhaust) apply simp
apply (subgoal_tac "2 ≤ length (ys @ [y])") apply simp
apply (rule_tac enumerator_length) by auto
lemma enumerator_increase: "⋀ as bs. ls ∈ set (enumerator m nmax) ⟹ as @ bs = ls ⟹ ∀ x ∈ set as. ∀ y ∈ set bs. x ≤ y"
apply (auto simp: enumerator_def del: Nat.diff_is_0_eq' split: if_split_asm intro: enumAppend_increase_rec)
apply (case_tac as) apply simp apply simp
apply (case_tac bs rule: rev_exhaust) apply simp apply simp apply auto
apply (drule_tac enumAppend_bound_rec) apply (auto simp:enumBase_simps)
by (auto dest!: enumAppend_increase_rec)
lemma enumerator_increasing: "ls ∈ set (enumerator m nmax) ⟹ increasing ls"
apply (rule increasing3)
by (auto dest: enumerator_increase)
definition incrIndexList :: "nat list ⇒ nat ⇒ nat ⇒ bool" where
"incrIndexList ls m nmax ≡
1 < m ∧ 1 < nmax ∧
hd ls = 0 ∧ last ls = (nmax - 1) ∧ length ls = m
∧ last (butlast ls) < last ls ∧ increasing ls"
lemma incrIndexList_1lem[simp]: "incrIndexList ls m nmax ⟹ Suc 0 < m"
by (unfold incrIndexList_def) simp
lemma incrIndexList_1len[simp]: "incrIndexList ls m nmax ⟹ Suc 0 < nmax"
by (unfold incrIndexList_def) simp
lemma incrIndexList_help2[simp]: "incrIndexList ls m nmax ⟹ hd ls = 0"
by (unfold incrIndexList_def) simp
lemma incrIndexList_help21[simp]: "incrIndexList (l # ls) m nmax ⟹ l = 0"
by (auto dest: incrIndexList_help2)
lemma incrIndexList_help3[simp]: "incrIndexList ls m nmax ⟹ last ls = (nmax - (Suc 0))"
by (unfold incrIndexList_def) simp
lemma incrIndexList_help4[simp]: "incrIndexList ls m nmax ⟹ length ls = m "
by (unfold incrIndexList_def) simp
lemma incrIndexList_help5[intro]: "incrIndexList ls m nmax ⟹ last (butlast ls) < nmax - Suc 0"
by (unfold incrIndexList_def) auto
lemma incrIndexList_help6[simp]: "incrIndexList ls m nmax ⟹ increasing ls"
by (unfold incrIndexList_def) simp
lemma incrIndexList_help7[simp]: "incrIndexList ls m nmax ⟹ ls ≠ []"
apply (subgoal_tac "length ls ≠ 0") apply force
apply simp
apply (subgoal_tac "1 < m") apply arith apply force done
lemma incrIndexList_help71[simp]: "¬ incrIndexList [] m nmax"
by (auto dest: incrIndexList_help7)
lemma incrIndexList_help8[simp]: "incrIndexList ls m nmax ⟹ butlast ls ≠ []"
proof (rule ccontr)
assume props: "incrIndexList ls m nmax" and butl: "¬ butlast ls ≠ []"
then have "ls ≠ []" by auto
then have ls': "ls = (butlast ls) @ [last ls]" by auto
define l where "l = last ls"
with butl ls' have "ls = [l]" by auto
then have "length ls = 1" by auto
with props have "m = 1" by auto
with props show "False" by (auto dest: incrIndexList_1lem)
qed
lemma incrIndexList_help81[simp]: "¬ incrIndexList [l] m nmax"
by (auto dest: incrIndexList_help8)
lemma incrIndexList_help9[intro]: "(incrIndexList ls m nmax) ⟹
x ∈ set (butlast ls) ⟹ x ≤ nmax - 2"
proof -
assume props: "(incrIndexList ls m nmax)" and x: "x ∈ set (butlast ls)"
then have "last (butlast ls) < last ls" by auto
with props have "last (butlast ls) < nmax - 1" by auto
then have leq: "last (butlast ls) ≤ nmax - 2" by arith
from props have "ls ≠ []" by auto
then have ls1: "ls = butlast ls @ [last ls]" by auto
define ls' where "ls' = butlast (butlast ls)"
define last2 where "last2 = last (butlast ls)"
define last1 where "last1 = last ls"
from props have "butlast ls ≠ []" by auto
with ls'_def last2_def have bls: "butlast ls = ls' @ [last2]" by auto
with last1_def ls1 props have ls3: "ls = ls' @ [last2] @ [last1]" by auto
from props have "increasing ls" by auto
with ls3 have increasing: "increasing (ls' @ ([last2] @ [last1]))" by auto
then have "x ∈ set ls' ⟹ x ≤ last2" by (auto intro: increasing2)
then have "x ∈ set (ls' @ [last2]) ⟹ x ≤ last2" by auto
with bls x have "x ≤ last2" by auto
with leq last2_def show ?thesis by auto
qed
lemma incrIndexList_help10[intro]: "(incrIndexList ls m nmax) ⟹
x ∈ set ls ⟹ x < nmax" apply (cases ls rule: rev_exhaust) apply auto
apply (frule incrIndexList_help3) apply (auto dest: incrIndexList_1len)
apply (frule incrIndexList_help9) apply auto apply (drule incrIndexList_1len)
by arith
lemma enumerator_correctness: "2 < m ⟹ 1 < nmax ⟹
ls ∈ set (enumerator m nmax) ⟹
incrIndexList ls m nmax"
proof -
assume m: "2 < m" and nmax: "1 < nmax" and enum: "ls ∈ set (enumerator m nmax)"
then have "(hd ls = 0 ∧ last ls = (nmax - 1) ∧ length ls = m ∧ last (butlast ls) < last ls ∧ increasing ls)"
by (auto intro: enumerator_increasing enumerator_hd enumerator_last enumerator_length2 enumerator_bound3 simp: set_enumerator_simps)
with m nmax show ?thesis by (unfold incrIndexList_def) auto
qed
lemma enumerator_completeness_help: "⋀ ls. increasing ls ⟹ ls ≠ [] ⟹ length ls = Suc ks ⟹ list_all (λx. x < Suc nmax) ls ⟹ ls ∈ set ((enumAppend nmax ^^ ks) (enumBase nmax))"
proof (induct ks)
case 0
assume "increasing ls" "ls ≠ []" "length ls = Suc 0" "list_all (λx. x < Suc nmax) ls"
then have "∃ x. ls = [x]"
apply (case_tac "ls::nat list") by auto
then obtain x where ls1: "ls = [x]" by auto
with 0 have "x < Suc nmax" by auto
with ls1 show ?case apply (simp add: enumBase_def) by auto
next
case (Suc n)
define ls' where "ls' = butlast ls"
define l where "l = last ls"
define ll where "ll = last ls'"
define bl where "bl = butlast ls'"
define ls'list where "ls'list = (enumAppend nmax ^^ n) (enumBase nmax)"
then have short: "(enumAppend nmax ^^ n) (enumBase nmax) = ls'list" by simp
from Suc have "ls ≠ []" by auto
then have "ls = butlast ls @ [last ls]" by auto
with ls'_def l_def have ls1: "ls = ls' @ [l]" by auto
with Suc have "length ls' = Suc n" by auto
then have ls'ne: "ls' ≠ []" by auto
with ll_def bl_def have ls'1: "ls' = bl @ [ll]" by auto
then have ll_in_ls': "ll ∈ set ls'" by simp
from Suc ls1 have "list_all (λx. x < Suc nmax) ls'" by auto
with ll_in_ls' have "ll < Suc nmax" by (induct ls') auto
with ll_def have llsmall: "last ls' ≤ nmax" by auto
from ls1 have l_in_ls: "l ∈ set ls" by auto
from Suc have "list_all (λx. x < Suc nmax) ls" by auto
with l_in_ls have "l < Suc nmax" by (induct ls) auto
then have lo: "l ≤ nmax" by auto
from Suc ls1 ls'1 have "increasing ((bl @ [ll]) @ [l])" by auto
then have "ll ≤ l" by (rule increasing2) auto
with ll_def have lu: "last ls' ≤ l" by simp
from Suc ls1 have vors: "ls' ∈ set ((enumAppend nmax ^^ n) (enumBase nmax))"
by (rule_tac Suc) (auto intro: increasing4)
with short have "ls' ∈ set ls'list" by auto
with short llsmall ls1 lo lu show ?case apply simp apply (simp add: enumAppend_def)
apply (intro bexI) by auto
qed
lemma enumerator_completeness: "2 < m ⟹ incrIndexList ls m nmax ⟹
ls ∈ set (enumerator m nmax)"
proof -
assume m: "2 < m" and props: "incrIndexList ls m nmax"
then have props': "(hd ls = 0 ∧ last ls = (nmax - 1)
∧ length ls = m ∧ last (butlast ls) < last ls ∧ increasing ls)"
by (unfold incrIndexList_def) auto
show ?thesis
proof -
have props'': "hd ls = 0 ∧ last ls = (nmax - 1) ∧ length ls = m ∧
increasing ls"
by (auto simp: props')
show "ls ∈ set (enumerator m nmax)"
proof -
from m props'' have l_ls: "2 < length ls" by auto
then have "∃ x y ks. ls = x # ks @ [y]"
apply (case_tac "ls::(nat list)") apply auto
apply (case_tac "list" rule: rev_exhaust) by auto
then obtain x y ks where "ls = x # ks @ [y]" by auto
with props'' have ls': "ls = 0 # ks @ [nmax - 1]" by auto
with l_ls have l_ms: "0 < length ks" by auto
then have ms_ne: "ks ≠ []" by auto
from ls' have lks: "length ks = length ls - 2" by auto
from props'' have nd: "increasing ls" by auto
from props'' have "⋀ z. z ∈ set ks ⟹ 0 ≤ z" by auto
from props'' ls' have "increasing ((0 # ks) @ [nmax - 1])" by auto
then have z: "⋀ z. z ∈ set ks ⟹ z ≤ (nmax - 1)"
by (drule_tac increasing2) auto
from props ls' have z': "⋀ z. z ∈ set ks ⟹ z ≤ (nmax - 2)" by auto
have "ks ∈ set ((enumAppend (nmax - 2)
^^ (length ks - Suc 0)) (enumBase (nmax - 2)))"
proof (cases "ks = []")
case True with ms_ne show ?thesis by simp
next
case False
from props'' have "increasing ls" by auto
with ls' have "increasing (0 # ks)" by (auto intro: increasing4)
then have "increasing ([0] @ ks)" by auto
then have ndks: "increasing ks" by (rule_tac increasing5)
have listall: "list_all (λx. x < Suc (nmax - 2)) ks"
apply (simp add: list_all_iff)
by (auto dest: z')
with False ndks show ?thesis
apply (rule_tac enumerator_completeness_help) by auto
qed
with lks props' have
"ks ∈ set ((enumAppend (nmax - 2) ^^ (m - 3)) (enumBase (nmax - 2)))" by auto
with m ls' show ?thesis by (simp add: enumerator_def)
qed
qed
qed
lemma enumerator_equiv[simp]:
"2 < n ⟹ 1 < m ⟹ is ∈ set(enumerator n m) = incrIndexList is n m"
by (auto intro: enumerator_correctness enumerator_completeness)
end
Theory FaceDivisionProps
section‹Properties of Face Division›
theory FaceDivisionProps
imports Plane EnumeratorProps
begin
subsection‹Finality›
lemma vertices_makeFaceFinal: "vertices(makeFaceFinal f g) = vertices g"
by(induct g)(simp add:vertices_graph_def makeFaceFinal_def)
lemma edges_makeFaceFinal: "ℰ (makeFaceFinal f g) = ℰ g"
proof -
{ fix fs
have "(⋃⇘f∈set (makeFaceFinalFaceList f fs)⇙ edges f) = (⋃⇘f∈ set fs⇙ edges f)"
apply(unfold makeFaceFinalFaceList_def)
apply(induct f)
by(induct fs) simp_all }
thus ?thesis by(simp add:edges_graph_def makeFaceFinal_def)
qed
lemma in_set_repl_setFin:
"f ∈ set fs ⟹ final f ⟹ f ∈ set (replace f' [setFinal f'] fs)"
by (induct fs) auto
lemma in_set_repl: "f ∈ set fs ⟹ f ≠ f' ⟹ f ∈ set (replace f' fs' fs)"
by (induct fs) auto
lemma makeFaceFinals_preserve_finals:
"f ∈ set (finals g) ⟹ f ∈ set (finals (makeFaceFinal f' g))"
by (induct g)
(simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
in_set_repl_setFin)
lemma len_faces_makeFaceFinal[simp]:
"|faces (makeFaceFinal f g)| = |faces g|"
by(simp add:makeFaceFinal_def makeFaceFinalFaceList_def)
lemma len_finals_makeFaceFinal:
"f ∈ ℱ g ⟹ ¬ final f ⟹ |finals (makeFaceFinal f g)| = |finals g| + 1"
by(simp add:makeFaceFinal_def finals_def makeFaceFinalFaceList_def
length_filter_replace1)
lemma len_nonFinals_makeFaceFinal:
"⟦ ¬ final f; f ∈ ℱ g⟧
⟹ |nonFinals (makeFaceFinal f g)| = |nonFinals g| - 1"
by(simp add:makeFaceFinal_def nonFinals_def makeFaceFinalFaceList_def
length_filter_replace2)
lemma set_finals_makeFaceFinal[simp]: "distinct(faces g) ⟹ f ∈ ℱ g ⟹
set(finals (makeFaceFinal f g)) = insert (setFinal f) (set(finals g))"
by(auto simp:finals_def makeFaceFinal_def makeFaceFinalFaceList_def
distinct_set_replace)
lemma splitFace_preserve_final:
"f ∈ set (finals g) ⟹ ¬ final f' ⟹
f ∈ set (finals (snd (snd (splitFace g i j f' ns))))"
by (induct g) (auto simp add: splitFace_def finals_def split_def
intro: in_set_repl)
lemma splitFace_nonFinal_face:
"¬ final (fst (snd (splitFace g i j f' ns)))"
by (simp add: splitFace_def split_def split_face_def)
lemma subdivFace'_preserve_finals:
"⋀n i f' g. f ∈ set (finals g) ⟹ ¬ final f' ⟹
f ∈ set (finals (subdivFace' g f' i n is))"
proof (induct "is")
case Nil then show ?case by(simp add:makeFaceFinals_preserve_finals)
next
case (Cons j "js") then show ?case
proof (cases j)
case None with Cons show ?thesis by simp
next
case (Some sj)
with Cons show ?thesis
by (auto simp: splitFace_preserve_final splitFace_nonFinal_face split_def)
qed
qed
lemma subdivFace_pres_finals:
"f ∈ set (finals g) ⟹ ¬ final f' ⟹
f ∈ set (finals (subdivFace g f' is))"
by(simp add:subdivFace_def subdivFace'_preserve_finals)
declare Nat.diff_is_0_eq' [simp del]
subsection ‹‹is_prefix››
definition is_prefix :: "'a list ⇒ 'a list ⇒ bool" where
"is_prefix ls vs ≡ (∃ bs. vs = ls @ bs)"
lemma is_prefix_add:
"is_prefix ls vs ⟹ is_prefix (as @ ls) (as @ vs)" by (simp add: is_prefix_def)
lemma is_prefix_hd[simp]:
"is_prefix [l] vs = (l = hd vs ∧ vs ≠ [])"
apply (rule iffI) apply (auto simp: is_prefix_def)
apply (intro exI) apply (subgoal_tac "vs = hd vs # tl vs") apply assumption by auto
lemma is_prefix_f[simp]:
"is_prefix (a#as) (a#vs) = is_prefix as vs" by (auto simp: is_prefix_def)
lemma splitAt_is_prefix: "ram ∈ set vs ⟹ is_prefix (fst (splitAt ram vs) @ [ram]) vs"
by (auto dest!: splitAt_ram simp: is_prefix_def)
subsection ‹‹is_sublist››
definition is_sublist :: "'a list ⇒ 'a list ⇒ bool" where
"is_sublist ls vs ≡ (∃ as bs. vs = as @ ls @ bs)"
lemma is_prefix_sublist:
"is_prefix ls vs ⟹ is_sublist ls vs" by (auto simp: is_prefix_def is_sublist_def)
lemma is_sublist_trans: "is_sublist as bs ⟹ is_sublist bs cs ⟹ is_sublist as cs"
apply (simp add: is_sublist_def) apply (elim exE)
apply (subgoal_tac "cs = (asaa @ asa) @ as @ (bsa @ bsaa)")
apply (intro exI) apply assumption by force
lemma is_sublist_add: "is_sublist as bs ⟹ is_sublist as (xs @ bs @ ys)"
apply (simp add: is_sublist_def) apply (elim exE)
apply (subgoal_tac "xs @ bs @ ys = (xs @ asa) @ as @ (bsa @ ys)")
apply (intro exI) apply assumption by auto
lemma is_sublist_rec:
"is_sublist xs ys =
(if length xs > length ys then False else
if xs = take (length xs) ys then True else is_sublist xs (tl ys))"
proof (simp add:is_sublist_def, goal_cases)
case 1 show ?case
proof (standard, goal_cases)
case 1 show ?case
proof (standard, goal_cases)
case xs: 1
show ?case
proof (standard, goal_cases)
case 1 show ?case by auto
next
case 2 show ?case
proof (standard, goal_cases)
case 1
have "ys = take |xs| ys @ drop |xs| ys" by simp
also have "… = [] @ xs @ drop |xs| ys" by(simp add:xs[symmetric])
finally show ?case by blast
qed
qed
qed
next
case 2 show ?case
proof (standard, goal_cases)
case xs_neq: 1
show ?case
proof (standard, goal_cases)
case 1 show ?case by auto
next
case 2 show ?case
proof (standard, goal_cases)
case not_less: 1 show ?case
proof (standard, goal_cases)
case 1
then obtain as bs where ys: "ys = as @ xs @ bs" by blast
have "as ≠ []" using xs_neq ys by auto
then obtain a as' where "as = a # as'"
by (simp add:neq_Nil_conv) blast
hence "tl ys = as' @ xs @ bs" by(simp add:ys)
thus ?case by blast
next
case 2
then obtain as bs where ys: "tl ys = as @ xs @ bs" by blast
have "ys ≠ []" using xs_neq not_less by auto
then obtain y ys' where "ys = y # ys'"
by (simp add:neq_Nil_conv) blast
hence "ys = (y#as) @ xs @ bs" using ys by simp
thus ?case by blast
qed
qed
qed
qed
qed
qed
lemma not_sublist_len[simp]:
"|ys| < |xs| ⟹ ¬ is_sublist xs ys"
by(simp add:is_sublist_rec)
lemma is_sublist_simp[simp]: "a ≠ v ⟹ is_sublist (a#as) (v#vs) = is_sublist (a#as) vs"
proof
assume av: "a ≠ v" and subl: "is_sublist (a # as) (v # vs)"
then obtain rs ts where vvs: "v#vs = rs @ (a # as) @ ts" by (auto simp: is_sublist_def)
with av have "rs ≠ []" by auto
with vvs have "tl (v#vs) = tl rs @ a # as @ ts" by auto
then have "vs = tl rs @ a # as @ ts" by auto
then show "is_sublist (a # as) vs" by (auto simp: is_sublist_def)
next
assume av: "a ≠ v" and subl: "is_sublist (a # as) vs"
then show "is_sublist (a # as) (v # vs)" apply (auto simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "v # asa @ a # as @ bs = (v # asa) @ a # as @ bs") apply assumption by auto
qed
lemma is_sublist_id[simp]: "is_sublist vs vs" apply (auto simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "vs = [] @ vs @ []") by (assumption) auto
lemma is_sublist_in: "is_sublist (a#as) vs ⟹ a ∈ set vs" by (auto simp: is_sublist_def)
lemma is_sublist_in1: "is_sublist [x,y] vs ⟹ y ∈ set vs" by (auto simp: is_sublist_def)
lemma is_sublist_notlast[simp]: "distinct vs ⟹ x = last vs ⟹ ¬ is_sublist [x,y] vs"
proof
assume dvs: "distinct vs" and xl: "x = last vs" and subl:"is_sublist [x, y] vs"
then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
define as where "as = rs @ [x]"
define bs where "bs = y # ts"
then have bsne: "bs ≠ []" by auto
from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
with as_def have xas: "x ∈ set as" by auto
from bsne vs2 have "last vs = last bs" by auto
with xl have "x = last bs" by auto
with bsne have "bs = (butlast bs) @ [x]" by auto
then have "x ∈ set bs" by (induct bs) auto
with xas vs2 dvs show False by auto
qed
lemma is_sublist_nth1: "is_sublist [x,y] ls ⟹
∃ i j. i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ Suc i = j"
proof -
assume subl: "is_sublist [x,y] ls"
then obtain as bs where "ls = as @ x # y # bs" by (auto simp: is_sublist_def)
then have "(length as) < length ls ∧ (Suc (length as)) < length ls ∧ ls!(length as) = x
∧ ls!(Suc (length as)) = y ∧ Suc (length as) = (Suc (length as))"
apply auto apply hypsubst_thin apply (induct as) by auto
then show ?thesis by auto
qed
lemma is_sublist_nth2: "∃ i j. i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ Suc i = j ⟹
is_sublist [x,y] ls "
proof -
assume "∃ i j. i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ Suc i = j"
then obtain i j where vors: "i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ Suc i = j" by auto
then have "ls = take (Suc (Suc i)) ls @ drop (Suc (Suc i)) ls" by auto
with vors have "ls = take (Suc i) ls @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
by (auto simp: take_Suc_conv_app_nth)
with vors have "ls = take i ls @ [ls!i] @ [ls! (Suc i)] @ drop (Suc (Suc i)) ls"
by (auto simp: take_Suc_conv_app_nth)
with vors show ?thesis by (auto simp: is_sublist_def)
qed
lemma is_sublist_tl: "is_sublist (a # as) vs ⟹ is_sublist as vs" apply (simp add: is_sublist_def)
apply (elim exE) apply (intro exI)
apply (subgoal_tac "vs = (asa @ [a]) @ as @ bs") apply assumption by auto
lemma is_sublist_hd: "is_sublist (a # as) vs ⟹ is_sublist [a] vs" apply (simp add: is_sublist_def) by auto
lemma is_sublist_hd_eq[simp]: "(is_sublist [a] vs) = (a ∈ set vs)" apply (rule_tac iffI)
apply (simp add: is_sublist_def) apply force
apply (simp add: is_sublist_def) apply (induct vs) apply force apply (case_tac "a = aa") apply force
apply (subgoal_tac "a ∈ set vs") apply simp apply (elim exE) apply (intro exI)
apply (subgoal_tac "aa # vs = (aa # as) @ a # bs") apply (assumption) by auto
lemma is_sublist_distinct_prefix:
"is_sublist (v#as) (v # vs) ⟹ distinct (v # vs) ⟹ is_prefix as vs"
proof -
assume d: "distinct (v # vs)" and subl: "is_sublist (v # as) (v # vs)"
from subl obtain rs ts where v_vs: "v # vs = rs @ (v # as) @ ts" by (simp add: is_sublist_def) auto
from d have v: "v ∉ set vs" by auto
then have "¬ is_sublist (v # as) vs" by (auto dest: is_sublist_hd)
with v_vs have "rs = []" apply (cases rs) by (auto simp: is_sublist_def)
with v_vs show "is_prefix as vs" by (auto simp: is_prefix_def)
qed
lemma is_sublist_distinct[intro]:
"is_sublist as vs ⟹ distinct vs ⟹ distinct as" by (auto simp: is_sublist_def)
lemma is_sublist_y_hd: "distinct vs ⟹ y = hd vs ⟹ ¬ is_sublist [x,y] vs"
proof
assume d: "distinct vs" and yh: "y = hd vs" and subl: "is_sublist [x, y] vs"
then obtain rs ts where vs: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
define as where "as = rs @ [x]"
then have asne: "as ≠ []" by auto
define bs where "bs = y # ts"
then have bsne: "bs ≠ []" by auto
from as_def bs_def have vs2: "vs = as @ bs" using vs by auto
from bs_def have xbs: "y ∈ set bs" by auto
from vs2 asne have "hd vs = hd as" by simp
with yh have "y = hd as" by auto
with asne have "y ∈ set as" by (induct as) auto
with d xbs vs2 show False by auto
qed
lemma is_sublist_at1: "distinct (as @ bs) ⟹ is_sublist [x,y] (as @ bs) ⟹ x ≠ (last as) ⟹
is_sublist [x,y] as ∨ is_sublist [x,y] bs"
proof (cases "x ∈ set as")
assume d: "distinct (as @ bs)" and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x ≠ last as"
define vs where "vs = as @ bs"
with d have dvs: "distinct vs" by auto
case True
with xnl subl have ind: "is_sublist (as@bs) vs ⟹ is_sublist [x, y] as"
proof (induct as)
case Nil
then show ?case by force
next
case (Cons a as)
assume ih: "⟦is_sublist (as@bs) vs; x ≠ last as; is_sublist [x,y] (as @ bs); x ∈ set as⟧ ⟹
is_sublist [x, y] as" and subl_aas_vs: "is_sublist ((a # as) @ bs) vs"
and xnl2: "x ≠ last (a # as)" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
and x: "x ∈ set (a # as)"
then have rule1: "x ≠ a ⟹ is_sublist [x,y] as" apply (cases "as = []") apply simp
apply (rule_tac ih) by (auto dest: is_sublist_tl)
from dvs subl_aas_vs have daas: "distinct (a # as @ bs)" apply (rule_tac is_sublist_distinct) by auto
from xnl2 have asne: "x = a ⟹ as ≠ []" by auto
with subl2 daas have yhdas: "x = a ⟹ y = hd as" apply simp apply (drule_tac is_sublist_distinct_prefix) by auto
with asne have "x = a ⟹ as = y # tl as" by auto
with asne yhdas have "x = a ⟹ is_prefix [x,y] (a # as)" by auto
then have rule2: "x = a ⟹ is_sublist [x,y] (a # as)" by (simp add: is_prefix_sublist)
from rule1 rule2 show ?case by (cases "x = a") auto
qed
from vs_def d have "is_sublist [x, y] as" by (rule_tac ind) auto
then show ?thesis by auto
next
assume d: "distinct (as @ bs)" and subl: "is_sublist [x, y] (as @ bs)" and xnl: "x ≠ last as"
define ars where "ars = as"
case False
with ars_def have xars: "x ∉ set ars" by auto
from subl have ind: "is_sublist as ars ⟹ is_sublist [x, y] bs"
proof (induct as)
case Nil
then show ?case by auto
next
case (Cons a as)
assume ih: "⟦is_sublist as ars; is_sublist [x, y] (as @ bs)⟧ ⟹ is_sublist [x, y] bs"
and subl_aasbsvs: "is_sublist (a # as) ars" and subl2: "is_sublist [x, y] ((a # as) @ bs)"
from subl_aasbsvs ars_def False have "x ≠ a" by (auto simp:is_sublist_in)
with subl_aasbsvs subl2 show ?thesis apply (rule_tac ih) by (auto dest: is_sublist_tl)
qed
from ars_def have "is_sublist [x, y] bs" by (rule_tac ind) auto
then show ?thesis by auto
qed
lemma is_sublist_at4: "distinct (as @ bs) ⟹ is_sublist [x,y] (as @ bs) ⟹
as ≠ [] ⟹ x = last as ⟹ y = hd bs"
proof -
assume d: "distinct (as @ bs)" and subl: "is_sublist [x,y] (as @ bs)"
and asne: "as ≠ []" and xl: "x = last as"
define vs where "vs = as @ bs"
with subl have "is_sublist [x,y] vs" by auto
then obtain rs ts where vs2: "vs = rs @ x # y # ts" by (auto simp: is_sublist_def)
from vs_def d have dvs:"distinct vs" by auto
from asne xl have as:"as = butlast as @ [x]" by auto
with vs_def have vs3: "vs = butlast as @ x # bs" by auto
from dvs vs2 vs3 have "rs = butlast as" apply (rule_tac dist_at1) by auto
then have "rs @ [x] = butlast as @ [x]" by auto
with as have "rs @ [x] = as" by auto
then have "as = rs @ [x]" by auto
with vs2 vs_def have "bs = y # ts" by auto
then show ?thesis by auto
qed
lemma is_sublist_at5: "distinct (as @ bs) ⟹ is_sublist [x,y] (as @ bs) ⟹
is_sublist [x,y] as ∨ is_sublist [x,y] bs ∨ x = last as ∧ y = hd bs"
apply (case_tac "as = []") apply simp apply (cases "x = last as")
apply (subgoal_tac "y = hd bs") apply simp
apply (rule is_sublist_at4) apply assumption+
apply (drule_tac is_sublist_at1) by auto
lemma is_sublist_rev: "is_sublist [a,b] (rev zs) = is_sublist [b,a] zs"
apply (simp add: is_sublist_def)
apply (intro iffI) apply (elim exE) apply (intro exI)
apply (subgoal_tac "zs = (rev bs) @ b # a # rev as") apply assumption
apply (subgoal_tac "rev (rev zs) = rev (as @ a # b # bs)")
apply (thin_tac "rev zs = as @ a # b # bs") apply simp
apply simp
apply (elim exE) apply (intro exI) by force
lemma is_sublist_at5'[simp]:
"distinct as ⟹ distinct bs ⟹ set as ∩ set bs = {} ⟹ is_sublist [x,y] (as @ bs) ⟹
is_sublist [x,y] as ∨ is_sublist [x,y] bs ∨ x = last as ∧ y = hd bs"
apply (subgoal_tac "distinct (as @ bs)") apply (drule is_sublist_at5) by auto
lemma splitAt_is_sublist1R[simp]: "ram ∈ set vs ⟹ is_sublist (fst (splitAt ram vs) @ [ram]) vs"
apply (auto dest!: splitAt_ram simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "vs = [] @ fst (splitAt ram vs) @ ram # snd (splitAt ram vs)") apply assumption by simp
lemma splitAt_is_sublist2R[simp]: "ram ∈ set vs ⟹ is_sublist (ram # snd (splitAt ram vs)) vs"
apply (auto dest!: splitAt_ram splitAt_no_ram simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs) @ []") apply assumption by auto
subsection ‹‹is_nextElem››
definition is_nextElem :: "'a list ⇒ 'a ⇒ 'a ⇒ bool" where
"is_nextElem xs x y ≡ is_sublist [x,y] xs ∨ xs ≠ [] ∧ x = last xs ∧ y = hd xs"
lemma is_nextElem_a[intro]: "is_nextElem vs a b ⟹ a ∈ set vs"
by (auto simp: is_nextElem_def is_sublist_def)
lemma is_nextElem_b[intro]: "is_nextElem vs a b ⟹ b ∈ set vs"
by (auto simp: is_nextElem_def is_sublist_def)
lemma is_nextElem_last_hd[intro]: "distinct vs ⟹ is_nextElem vs x y ⟹
x = last vs ⟹ y = hd vs"
by (auto simp: is_nextElem_def)
lemma is_nextElem_last_ne[intro]: "distinct vs ⟹ is_nextElem vs x y ⟹
x = last vs ⟹ vs ≠ []"
by (auto simp: is_nextElem_def)
lemma is_nextElem_sublistI: "is_sublist [x,y] vs ⟹ is_nextElem vs x y"
by (auto simp: is_nextElem_def)
lemma is_nextElem_nth1: "is_nextElem ls x y ⟹ ∃ i j. i < length ls
∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ (Suc i) mod (length ls) = j"
proof (cases "is_sublist [x,y] ls")
assume is_nextElem: "is_nextElem ls x y"
case True then show ?thesis apply (drule_tac is_sublist_nth1) by auto
next
assume is_nextElem: "is_nextElem ls x y"
case False with is_nextElem have hl: "ls ≠ [] ∧ last ls = x ∧ hd ls = y"
by (auto simp: is_nextElem_def)
then have j: "ls!0 = y" by (cases ls) auto
from hl have i: "ls!(length ls - 1) = x" by (cases ls rule: rev_exhaust) auto
from i j hl have "(length ls - 1) < length ls ∧ 0 < length ls ∧ ls!(length ls - 1) = x
∧ ls!0 = y ∧ (Suc (length ls - 1)) mod (length ls) = 0" by auto
then show ?thesis apply (intro exI) .
qed
lemma is_nextElem_nth2: " ∃ i j. i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y
∧ (Suc i) mod (length ls) = j ⟹ is_nextElem ls x y"
proof -
assume "∃ i j. i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y ∧ (Suc i) mod (length ls) = j"
then obtain i j where vors: "i < length ls ∧ j < length ls ∧ ls!i = x ∧ ls!j = y
∧ (Suc i) mod (length ls) = j" by auto
then show ?thesis
proof (cases "Suc i = length ls")
case True with vors have "j = 0" by auto
with True vors show ?thesis apply (auto simp: is_nextElem_def)
apply (cases ls rule: rev_exhaust) apply auto apply (cases ls) by auto
next
case False with vors have "is_sublist [x,y] ls"
apply (rule_tac is_sublist_nth2) by auto
then show ?thesis by (simp add: is_nextElem_def)
qed
qed
lemma is_nextElem_rotate1_aux:
"is_nextElem (rotate m ls) x y ⟹ is_nextElem ls x y"
proof -
assume is_nextElem: "is_nextElem (rotate m ls) x y"
define n where "n = m mod length ls"
then have rot_eq: "rotate m ls = rotate n ls"
by (auto intro: rotate_conv_mod)
with is_nextElem have "is_nextElem (rotate n ls) x y"
by simp
then obtain i j where vors:"i < length (rotate n ls) ∧ j < length (rotate n ls) ∧
(rotate n ls)!i = x ∧ (rotate n ls)!j = y ∧
(Suc i) mod (length (rotate n ls)) = j"
by (drule_tac is_nextElem_nth1) auto
then have lls: "0 < length ls"
by auto
define k where "k = (i+n) mod (length ls)"
with lls have sk: "k < length ls"
by simp
from k_def lls vors have "ls!k = (rotate n ls)!(i mod (length ls))"
by (simp add: nth_rotate)
with vors have lsk: "ls!k = x"
by simp
define l where "l = (j+n) mod (length ls)"
with lls have sl: "l < length ls"
by simp
from l_def lls vors have "ls!l = (rotate n ls)!(j mod (length ls))"
by (simp add: nth_rotate)
with vors have lsl: "ls!l = y"
by simp
from vors k_def l_def
have "(Suc i) mod length ls = j"
by simp
then have "(Suc i) mod length ls = j mod length ls"
by auto
then have "((Suc i) mod length ls + n mod (length ls)) mod length ls
= (j mod length ls + n mod (length ls)) mod length ls"
by simp
then have "((Suc i) + n) mod length ls = (j + n) mod length ls"
by (simp add: mod_simps)
with vors k_def l_def have "(Suc k) mod (length ls) = l"
by (simp add: mod_simps)
with sk lsk sl lsl
show ?thesis
by (auto intro: is_nextElem_nth2)
qed
lemma is_nextElem_rotate_eq[simp]: "is_nextElem (rotate m ls) x y = is_nextElem ls x y"
apply (auto dest: is_nextElem_rotate1_aux) apply (rule is_nextElem_rotate1_aux)
apply (subgoal_tac "is_nextElem (rotate (length ls - m mod length ls) (rotate m ls)) x y")
apply assumption by simp
lemma is_nextElem_congs_eq: "ls ≅ ms ⟹ is_nextElem ls x y = is_nextElem ms x y"
by (auto simp: congs_def)
lemma is_nextElem_rev[simp]: "is_nextElem (rev zs) a b = is_nextElem zs b a"
apply (simp add: is_nextElem_def is_sublist_rev)
apply (case_tac "zs = []") apply simp apply simp
apply (case_tac "a = hd zs") apply (case_tac "zs") apply simp apply simp apply simp
apply (case_tac "a = last (rev zs) ∧ b = last zs") apply simp
apply (case_tac "zs" rule: rev_exhaust) apply simp
apply (case_tac "ys") apply simp apply simp by force
lemma is_nextElem_circ:
"⟦ distinct xs; is_nextElem xs a b; is_nextElem xs b a ⟧ ⟹ |xs| ≤ 2"
apply(drule is_nextElem_nth1)
apply(drule is_nextElem_nth1)
apply (clarsimp)
apply(rename_tac i j)
apply(frule_tac i=j and j = "Suc i mod |xs|" in nth_eq_iff_index_eq)
apply assumption+
apply(frule_tac j=i and i = "Suc j mod |xs|" in nth_eq_iff_index_eq)
apply assumption+
apply(rule ccontr)
apply(simp add: distinct_conv_nth mod_Suc)
done
subsection‹‹nextElem, sublist, is_nextElem››
lemma is_sublist_eq: "distinct vs ⟹ c ≠ y ⟹
(nextElem vs c x = y) = is_sublist [x,y] vs"
proof -
assume d: "distinct vs" and c: "c ≠ y"
have r1: "nextElem vs c x = y ⟹ is_sublist [x,y] vs"
proof -
assume fn: "nextElem vs c x = y"
with c show ?thesis by(drule_tac nextElem_cases)(auto simp: is_sublist_def)
qed
with d have r2: "is_sublist [x,y] vs ⟹ nextElem vs c x = y"
apply (simp add: is_sublist_def) apply (elim exE) by auto
show ?thesis apply (intro iffI r1) by (auto intro: r2)
qed
lemma is_nextElem1: "distinct vs ⟹ x ∈ set vs ⟹ nextElem vs (hd vs) x = y ⟹ is_nextElem vs x y"
proof -
assume d: "distinct vs" and x: "x ∈ set vs" and fn: "nextElem vs (hd vs) x = y"
from x have r0: "vs ≠ []" by auto
from d fn have r1: "x = last vs ⟹ y = hd vs" by (auto)
from d fn have r3: "hd vs ≠ y ⟹ (∃ a b. vs = a @ [x,y] @ b)" by (drule_tac nextElem_cases) auto
from x obtain n where xn:"x = vs!n" and nl: "n < length vs" by (auto simp: in_set_conv_nth)
define as where "as = take n vs"
define bs where "bs = drop (Suc n) vs"
from as_def bs_def xn nl have vs:"vs = as @ [x] @ bs" by (auto intro: id_take_nth_drop)
then have r2: "x ≠ last vs ⟹ y ≠ hd vs"
proof -
assume notx: "x ≠ last vs"
from vs notx have "bs ≠ []" by auto
with vs have r2: "vs = as @ [x, hd bs] @ tl bs" by auto
with d have ineq: "hd bs ≠ hd vs" by (cases as) auto
from d fn r2 have "y = hd bs" by auto
with ineq show ?thesis by auto
qed
from r0 r1 r2 r3 show ?thesis apply (simp add:is_nextElem_def is_sublist_def)
apply (cases "x = last vs") by auto
qed
lemma is_nextElem2: "distinct vs ⟹ x ∈ set vs ⟹ is_nextElem vs x y ⟹ nextElem vs (hd vs) x = y"
proof -
assume d: "distinct vs" and x: "x ∈ set vs" and is_nextElem: "is_nextElem vs x y"
then show ?thesis apply (simp add: is_nextElem_def) apply (cases "is_sublist [x,y] vs")
apply (cases "y = hd vs")
apply (simp add: is_sublist_def) apply (force dest: distinct_hd_not_cons)
apply (subgoal_tac "hd vs ≠ y") apply (simp add: is_sublist_eq) by auto
qed
lemma nextElem_is_nextElem:
"distinct xs ⟹ x ∈ set xs ⟹
is_nextElem xs x y = (nextElem xs (hd xs) x = y)"
by (auto intro!: is_nextElem1 is_nextElem2)
lemma nextElem_congs_eq: "xs ≅ ys ⟹ distinct xs ⟹ x ∈ set xs ⟹
nextElem xs (hd xs) x = nextElem ys (hd ys) x"
proof -
assume eq: "xs ≅ ys" and dist: "distinct xs" and x: "x ∈ set xs"
define y where "y = nextElem xs (hd xs) x"
then have f1:"nextElem xs (hd xs) x = y" by auto
with dist x have "is_nextElem xs x y" by (auto intro: is_nextElem1)
with eq have "is_nextElem ys x y" by (simp add:is_nextElem_congs_eq)
with eq dist x have f2:"nextElem ys (hd ys) x = y"
by (auto simp: congs_distinct intro: is_nextElem2)
from f1 f2 show ?thesis by auto
qed
lemma is_sublist_is_nextElem: "distinct vs ⟹ is_nextElem vs x y ⟹ is_sublist as vs ⟹ x ∈ set as ⟹ x ≠ last as ⟹ is_sublist [x,y] as"
proof -
assume d: "distinct vs" and is_nextElem: "is_nextElem vs x y" and subl: "is_sublist as vs" and xin: "x ∈ set as" and xnl: "x ≠ last as"
from xin have asne: "as ≠ []" by auto
with subl have vsne: "vs ≠ []" by (auto simp: is_sublist_def)
from subl obtain rs ts where vs: "vs = rs @ as @ ts" apply (simp add: is_sublist_def) apply (elim exE) by auto
with d xnl asne have "x ≠ last vs"
proof (cases "ts = []")
case True
with d xnl asne vs show ?thesis by force
next
define lastvs where "lastvs = last ts"
case False
with vs lastvs_def have vs2: "vs = rs @ as @ butlast ts @ [lastvs]" by auto
with d have "lastvs ∉ set as" by auto
with xin have "lastvs ≠ x" by auto
with vs2 show ?thesis by auto
qed
with is_nextElem have subl_vs: "is_sublist [x,y] vs" by (auto simp: is_nextElem_def)
from d xin vs have "¬ is_sublist [x] rs" by auto
then have nrs: "¬ is_sublist [x,y] rs" by (auto dest: is_sublist_hd)
from d xin vs have "¬ is_sublist [x] ts" by auto
then have nts: "¬ is_sublist [x,y] ts" by (auto dest: is_sublist_hd)
from d xin vs have xnrs: "x ∉ set rs" by auto
then have notrs: "¬ is_sublist [x,y] rs" by (auto simp:is_sublist_in)
from xnrs have xnlrs: "rs ≠ [] ⟹ x ≠ last rs" by (induct rs) auto
from d xin vs have xnts: "x ∉ set ts" by auto
then have notts: "¬ is_sublist [x,y] ts" by (auto simp:is_sublist_in)
from d vs subl_vs have "is_sublist [x,y] rs ∨ is_sublist [x,y] (as@ts)" apply (cases "rs = []") apply simp apply (rule_tac is_sublist_at1) by (auto intro!: xnlrs)
with notrs have "is_sublist [x,y] (as@ts)" by auto
with d vs xnl have "is_sublist [x,y] as ∨ is_sublist [x,y] ts" apply (rule_tac is_sublist_at1) by auto
with notts show "is_sublist [x,y] as" by auto
qed
subsection ‹‹before››
definition before :: "'a list ⇒ 'a ⇒ 'a ⇒ bool" where
"before vs ram1 ram2 ≡ ∃ a b c. vs = a @ ram1 # b @ ram2 # c"
lemma before_dist_fst_fst[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 (fst (splitAt ram2 vs)))"
apply (simp add: before_def) apply (elim exE)
apply (drule splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_dist_fst_snd[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ fst (splitAt ram2 (snd (splitAt ram1 vs))) = snd (splitAt ram1 (fst (splitAt ram2 vs)))"
apply (simp add: before_def) apply (elim exE)
apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_dist_snd_fst[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ snd (splitAt ram2 (fst (splitAt ram1 vs))) = snd (splitAt ram1 (snd (splitAt ram2 vs)))"
apply (simp add: before_def) apply (elim exE)
apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_dist_snd_snd[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ snd (splitAt ram2 (snd (splitAt ram1 vs))) = fst (splitAt ram1 (snd (splitAt ram2 vs)))"
apply (simp add: before_def) apply (elim exE)
apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_dist_snd[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ fst (splitAt ram1 (snd (splitAt ram2 vs))) = snd (splitAt ram2 vs)"
apply (simp add: before_def) apply (elim exE)
apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_dist_fst[simp]: "before vs ram1 ram2 ⟹ distinct vs ⟹ fst (splitAt ram1 (fst (splitAt ram2 vs))) = fst (splitAt ram1 vs)"
apply (simp add: before_def) apply (elim exE)
apply (drule_tac splitAt_dist_ram_all) by (auto dest!: pairD)
lemma before_or: "ram1 ∈ set vs ⟹ ram2 ∈ set vs ⟹ ram1 ≠ ram2 ⟹ before vs ram1 ram2 ∨ before vs ram2 ram1"
proof -
assume r1: "ram1 ∈ set vs" and r2: "ram2 ∈ set vs" and r12: "ram1 ≠ ram2"
then show ?thesis
proof (cases "ram2 ∈ set (snd (splitAt ram1 vs))")
define a where "a = fst (splitAt ram1 vs)"
define b where "b = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
define c where "c = snd (splitAt ram2 (snd (splitAt ram1 vs)))"
case True with r1 a_def b_def c_def have "vs = a @ [ram1] @ b @ [ram2] @ c"
by (auto dest!: splitAt_ram)
then show ?thesis apply (simp add: before_def) by auto
next
define ab where "ab = fst (splitAt ram1 vs)"
case False
with r1 r2 r12 ab_def have r2': "ram2 ∈ set ab" by (auto intro: splitAt_ram3)
define a where "a = fst (splitAt ram2 ab)"
define b where "b = snd (splitAt ram2 ab)"
define c where "c = snd (splitAt ram1 vs)"
from r1 ab_def c_def have "vs = ab @ [ram1] @ c" by (auto dest!: splitAt_ram)
with r2' a_def b_def have "vs = (a @ [ram2] @ b) @ [ram1] @ c" by (drule_tac splitAt_ram) simp
then show ?thesis apply (simp add: before_def) apply (rule disjI2) by auto
qed
qed
lemma before_r1:
"before vs r1 r2 ⟹ r1 ∈ set vs" by (auto simp: before_def)
lemma before_r2:
"before vs r1 r2 ⟹ r2 ∈ set vs" by (auto simp: before_def)
lemma before_dist_r2:
"distinct vs ⟹ before vs r1 r2 ⟹ r2 ∈ set (snd (splitAt r1 vs))"
proof -
assume d: "distinct vs" and b: "before vs r1 r2"
from d b have ex1: "∃! s. (vs = (fst s) @ r1 # snd (s))" apply (drule_tac before_r1) apply (rule distinct_unique1) by auto
from d b ex1 show ?thesis apply (unfold before_def)
proof (elim exE ex1E)
fix a b c s
assume vs: "vs = a @ r1 # b @ r2 # c" and "∀y. vs = fst y @ r1 # snd y ⟶ y = s"
then have "⋀ y. vs = fst y @ r1 # snd y ⟶ y = s" by (clarify, hypsubst_thin, auto)
then have single: "⋀ y. vs = fst y @ r1 # snd y ⟹ y = s" by auto
define bc where "bc = b @ r2 # c"
with vs have vs2: "vs = a @ r1 # bc" by auto
from bc_def have r2: "r2 ∈ set bc" by auto
define t where "t = (a,bc)"
with vs2 have vs3: "vs = fst (t) @ r1 # snd (t)" by auto
with single have ts: "t = s" by (rule_tac single) auto
from b have "splitAt r1 vs = s" apply (drule_tac before_r1) apply (drule_tac splitAt_ram) by (rule single) auto
with ts have "t = splitAt r1 vs" by simp
with t_def have "bc = snd(splitAt r1 vs)" by simp
with r2 show ?thesis by simp
qed
qed
lemma before_dist_not_r2[intro]:
"distinct vs ⟹ before vs r1 r2 ⟹ r2 ∉ set (fst (splitAt r1 vs))" apply (frule before_dist_r2) by (auto dest: splitAt_distinct_fst_snd)
lemma before_dist_r1:
"distinct vs ⟹ before vs r1 r2 ⟹ r1 ∈ set (fst (splitAt r2 vs))"
proof -
assume d: "distinct vs" and b: "before vs r1 r2"
from d b have ex1: "∃! s. (vs = (fst s) @ r2 # snd (s))" apply (drule_tac before_r2) apply (rule distinct_unique1) by auto
from d b ex1 show ?thesis apply (unfold before_def)
proof (elim exE ex1E)
fix a b c s
assume vs: "vs = a @ r1 # b @ r2 # c" and "∀y. vs = fst y @ r2 # snd y ⟶ y = s"
then have "⋀ y. vs = fst y @ r2 # snd y ⟶ y = s" by (clarify, hypsubst_thin, auto)
then have single: "⋀ y. vs = fst y @ r2 # snd y ⟹ y = s" by auto
define ab where "ab = a @ r1 # b"
with vs have vs2: "vs = ab @ r2 # c" by auto
from ab_def have r1: "r1 ∈ set ab" by auto
define t where "t = (ab,c)"
with vs2 have vs3: "vs = fst (t) @ r2 # snd (t)" by auto
with single have ts: "t = s" by (rule_tac single) auto
from b have "splitAt r2 vs = s" apply (drule_tac before_r2) apply (drule_tac splitAt_ram) by (rule single) auto
with ts have "t = splitAt r2 vs" by simp
with t_def have "ab = fst(splitAt r2 vs)" by simp
with r1 show ?thesis by simp
qed
qed
lemma before_dist_not_r1[intro]:
"distinct vs ⟹ before vs r1 r2 ⟹ r1 ∉ set (snd (splitAt r2 vs))" apply (frule before_dist_r1) by (auto dest: splitAt_distinct_fst_snd)
lemma before_snd:
"r2 ∈ set (snd (splitAt r1 vs)) ⟹ before vs r1 r2"
proof -
assume r2: "r2 ∈ set (snd (splitAt r1 vs))"
from r2 have r1: "r1 ∈ set vs" apply (rule_tac ccontr) apply (drule splitAt_no_ram) by simp
define a where "a = fst (splitAt r1 vs)"
define bc where "bc = snd (splitAt r1 vs)"
define b where "b = fst (splitAt r2 bc)"
define c where "c = snd (splitAt r2 bc)"
from r1 a_def bc_def have vs: "vs = a @ [r1] @ bc" by (auto dest: splitAt_ram)
from r2 bc_def have r2: "r2 ∈ set bc" by simp
with b_def c_def have "bc = b @ [r2] @ c" by (auto dest: splitAt_ram)
with vs show ?thesis by (simp add: before_def) auto
qed
lemma before_fst:
"r2 ∈ set vs ⟹ r1 ∈ set (fst (splitAt r2 vs)) ⟹ before vs r1 r2"
proof -
assume r2: "r2 ∈ set vs" and r1: "r1 ∈ set (fst (splitAt r2 vs))"
define ab where "ab = fst (splitAt r2 vs)"
define c where "c = snd (splitAt r2 vs)"
define a where "a = fst (splitAt r1 ab)"
define b where "b = snd (splitAt r1 ab)"
from r2 ab_def c_def have vs: "vs = ab @ [r2] @ c" by (auto dest: splitAt_ram)
from r1 ab_def have r1: "r1 ∈ set ab" by simp
with a_def b_def have "ab = a @ [r1] @ b" by (auto dest: splitAt_ram)
with vs show ?thesis by (simp add: before_def) auto
qed
lemma before_dist_eq_fst:
"distinct vs ⟹ r2 ∈ set vs ⟹ r1 ∈ set (fst (splitAt r2 vs)) = before vs r1 r2"
by (auto intro: before_fst before_dist_r1)
lemma before_dist_eq_snd:
"distinct vs ⟹ r2 ∈ set (snd (splitAt r1 vs)) = before vs r1 r2"
by (auto intro: before_snd before_dist_r2)
lemma before_dist_not1:
"distinct vs ⟹ before vs ram1 ram2 ⟹ ¬ before vs ram2 ram1"
proof
assume d: "distinct vs" and b1: "before vs ram2 ram1" and b2: "before vs ram1 ram2"
from b2 have r1: "ram1 ∈ set vs" by (drule_tac before_r1)
from d b1 have r2: "ram2 ∈ set (fst (splitAt ram1 vs))" by (rule before_dist_r1)
from d b2 have r2':"ram2 ∈ set (snd (splitAt ram1 vs))" by (rule before_dist_r2)
from d r1 r2 r2' show "False" by (drule_tac splitAt_distinct_fst_snd) auto
qed
lemma before_dist_not2:
"distinct vs ⟹ ram1 ∈ set vs ⟹ ram2 ∈ set vs ⟹ ram1 ≠ ram2 ⟹ ¬ (before vs ram1 ram2) ⟹ before vs ram2 ram1"
proof -
assume "distinct vs" "ram1 ∈ set vs " "ram2 ∈ set vs" "ram1 ≠ ram2" "¬ before vs ram1 ram2"
then show "before vs ram2 ram1" apply (frule_tac before_or) by auto
qed
lemma before_dist_eq:
"distinct vs ⟹ ram1 ∈ set vs ⟹ ram2 ∈ set vs ⟹ ram1 ≠ ram2 ⟹ ( ¬ (before vs ram1 ram2)) = before vs ram2 ram1"
by (auto intro: before_dist_not2 dest: before_dist_not1)
lemma before_vs:
"distinct vs ⟹ before vs ram1 ram2 ⟹ vs = fst (splitAt ram1 vs) @ ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)"
proof -
assume d: "distinct vs" and b: "before vs ram1 ram2"
define s where "s = snd (splitAt ram1 vs)"
from b have "ram1 ∈ set vs" by (auto simp: before_def)
with s_def have vs: "vs = fst (splitAt ram1 vs) @ [ram1] @ s" by (auto dest: splitAt_ram)
from d b s_def have "ram2 ∈ set s" by (auto intro: before_dist_r2)
then have snd: "s = fst (splitAt ram2 s) @ [ram2] @ snd (splitAt ram2 s)"
by (auto dest: splitAt_ram)
with vs have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 s) @ [ram2] @ snd (splitAt ram2 s)" by auto
with d b s_def show ?thesis by auto
qed
subsection ‹@{const between}›
definition pre_between :: "'a list ⇒ 'a ⇒ 'a ⇒ bool" where
"pre_between vs ram1 ram2 ≡
distinct vs ∧ ram1 ∈ set vs ∧ ram2 ∈ set vs ∧ ram1 ≠ ram2"
declare pre_between_def [simp]
lemma pre_between_dist[intro]:
"pre_between vs ram1 ram2 ⟹ distinct vs" by (auto simp: pre_between_def)
lemma pre_between_r1[intro]:
"pre_between vs ram1 ram2 ⟹ ram1 ∈ set vs" by auto
lemma pre_between_r2[intro]:
"pre_between vs ram1 ram2 ⟹ ram2 ∈ set vs" by auto
lemma pre_between_r12[intro]:
"pre_between vs ram1 ram2 ⟹ ram1 ≠ ram2" by auto
lemma pre_between_symI:
"pre_between vs ram1 ram2 ⟹ pre_between vs ram2 ram1" by auto
lemma pre_between_before[dest]:
"pre_between vs ram1 ram2 ⟹ before vs ram1 ram2 ∨ before vs ram2 ram1" by (rule_tac before_or) auto
lemma pre_between_rotate1[intro]:
"pre_between vs ram1 ram2 ⟹ pre_between (rotate1 vs) ram1 ram2" by auto
lemma pre_between_rotate[intro]:
"pre_between vs ram1 ram2 ⟹ pre_between (rotate n vs) ram1 ram2" by auto
lemma before_xor:
"pre_between vs ram1 ram2 ⟹ (¬ before vs ram1 ram2) = before vs ram2 ram1"
by (simp add: before_dist_eq)
declare pre_between_def [simp del]
lemma between_simp1[simp]:
"before vs ram1 ram2 ⟹ pre_between vs ram1 ram2 ⟹
between vs ram1 ram2 = fst (splitAt ram2 (snd (splitAt ram1 vs)))"
by (simp add: pre_between_def between_def split_def before_dist_eq_snd)
lemma between_simp2[simp]:
"before vs ram1 ram2 ⟹ pre_between vs ram1 ram2 ⟹
between vs ram2 ram1 = snd (splitAt ram2 vs) @ fst (splitAt ram1 vs)"
proof -
assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2"
from p b have b2: "¬ before vs ram2 ram1" apply (simp add: pre_between_def) by (auto dest: before_dist_not1)
with p have "ram2 ∉ set (fst (splitAt ram1 vs))" by (simp add: pre_between_def before_dist_eq_fst)
then have "fst (splitAt ram1 vs) = fst (splitAt ram2 (fst (splitAt ram1 vs)))" by (auto dest: splitAt_no_ram)
then have "fst (splitAt ram2 (fst (splitAt ram1 vs))) = fst (splitAt ram1 vs)" by auto
with b2 b p show ?thesis apply (simp add: pre_between_def between_def split_def)
by (auto dest: before_dist_not_r1)
qed
lemma between_not_r1[intro]:
"distinct vs ⟹ ram1 ∉ set (between vs ram1 ram2)"
proof (cases "pre_between vs ram1 ram2")
assume d: "distinct vs"
case True then have p: "pre_between vs ram1 ram2" by auto
then show "ram1 ∉ set (between vs ram1 ram2)"
proof (cases "before vs ram1 ram2")
case True with d p show ?thesis by (auto del: notI)
next
from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
case False with p have "before vs ram2 ram1" by auto
with d p2 show ?thesis by (auto del: notI)
qed
next
assume d:"distinct vs"
case False then have p: "¬ pre_between vs ram1 ram2" by auto
then show ?thesis
proof (cases "ram1 = ram2")
case True with d have h1:"ram2 ∉ set (snd (splitAt ram2 vs))" by (auto del: notI)
from True d have h2: "ram2 ∉ set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
with True d h1 show ?thesis by (auto simp: between_def split_def)
next
case False then have neq: "ram1 ≠ ram2" by auto
then show ?thesis
proof (cases "ram1 ∉ set vs")
case True with d show ?thesis by (auto dest: splitAt_no_ram splitAt_in_fst simp: between_def split_def)
next
case False then have r1in: "ram1 ∈ set vs" by auto
then show ?thesis
proof (cases "ram2 ∉ set vs")
from d have h1: "ram1 ∉ set (fst (splitAt ram1 vs))" by (auto del: notI)
case True with d h1 show ?thesis
by (auto dest: splitAt_not1 splitAt_in_fst splitAt_ram
splitAt_no_ram simp: between_def split_def del: notI)
next
case False then have r2in: "ram2 ∈ set vs" by auto
with d neq r1in have "pre_between vs ram1 ram2"
by (auto simp: pre_between_def)
with p show ?thesis by auto
qed
qed
qed
qed
lemma between_not_r2[intro]:
"distinct vs ⟹ ram2 ∉ set (between vs ram1 ram2)"
proof (cases "pre_between vs ram1 ram2")
assume d: "distinct vs"
case True then have p: "pre_between vs ram1 ram2" by auto
then show "ram2 ∉ set (between vs ram1 ram2)"
proof (cases "before vs ram1 ram2")
from d have "ram2 ∉ set (fst (splitAt ram2 vs))" by (auto del: notI)
then have h1: "ram2 ∉ set (snd (splitAt ram1 (fst (splitAt ram2 vs))))"
by (auto dest: splitAt_in_fst)
case True with d p h1 show ?thesis by (auto del: notI)
next
from p have p2: "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
case False with p have "before vs ram2 ram1" by auto
with d p2 show ?thesis by (auto del: notI)
qed
next
assume d:"distinct vs"
case False then have p: "¬ pre_between vs ram1 ram2" by auto
then show ?thesis
proof (cases "ram1 = ram2")
case True with d have h1:"ram2 ∉ set (snd (splitAt ram2 vs))" by (auto del: notI)
from True d have h2: "ram2 ∉ set (fst (splitAt ram2 (fst (splitAt ram2 vs))))" by (auto del: notI)
with True d h1 show ?thesis by (auto simp: between_def split_def)
next
case False then have neq: "ram1 ≠ ram2" by auto
then show ?thesis
proof (cases "ram2 ∉ set vs")
case True with d show ?thesis
by (auto dest: splitAt_no_ram splitAt_in_fst
splitAt_in_fst simp: between_def split_def)
next
case False then have r1in: "ram2 ∈ set vs" by auto
then show ?thesis
proof (cases "ram1 ∉ set vs")
from d have h1: "ram1 ∉ set (fst (splitAt ram1 vs))" by (auto del: notI)
case True with d h1 show ?thesis by (auto dest: splitAt_ram splitAt_no_ram simp: between_def split_def del: notI)
next
case False then have r2in: "ram1 ∈ set vs" by auto
with d neq r1in have "pre_between vs ram1 ram2" by (auto simp: pre_between_def)
with p show ?thesis by auto
qed
qed
qed
qed
lemma between_distinct[intro]:
"distinct vs ⟹ distinct (between vs ram1 ram2)"
proof -
assume vs: "distinct vs"
define a where "a = fst (splitAt ram1 vs)"
define b where "b = snd (splitAt ram1 vs)"
from a_def b_def have ab: "(a,b) = splitAt ram1 vs" by auto
with vs have ab_disj:"set a ∩ set b = {}" by (drule_tac splitAt_distinct_ab) auto
define c where "c = fst (splitAt ram2 a)"
define d where "d = snd (splitAt ram2 a)"
from c_def d_def have c_d: "(c,d) = splitAt ram2 a" by auto
with ab_disj have "set c ∩ set b = {}" by (drule_tac splitAt_subset_ab) auto
with vs a_def b_def c_def show ?thesis
by (auto simp: between_def split_def splitAt_no_ram dest: splitAt_ram intro: splitAt_distinct_fst splitAt_distinct_snd)
qed
lemma between_distinct_r12:
"distinct vs ⟹ ram1 ≠ ram2 ⟹ distinct (ram1 # between vs ram1 ram2 @ [ram2])" by (auto del: notI)
lemma between_vs:
"before vs ram1 ram2 ⟹ pre_between vs ram1 ram2 ⟹
vs = fst (splitAt ram1 vs) @ ram1 # (between vs ram1 ram2) @ ram2 # snd (splitAt ram2 vs)"
apply (simp) apply (frule pre_between_dist) apply (drule before_vs) by auto
lemma between_in:
"before vs ram1 ram2 ⟹ pre_between vs ram1 ram2 ⟹ x ∈ set vs ⟹ x = ram1 ∨ x ∈ set (between vs ram1 ram2) ∨ x = ram2 ∨ x ∈ set (between vs ram2 ram1)"
proof -
assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and xin: "x ∈ set vs"
define a where "a = fst (splitAt ram1 vs)"
define b where "b = between vs ram1 ram2"
define c where "c = snd (splitAt ram2 vs)"
from p have "distinct vs" by auto
from p b a_def b_def c_def have "vs = a @ ram1 # b @ ram2 # c" apply (drule_tac between_vs) by auto
with xin have "x ∈ set (a @ ram1 # b @ ram2 # c)" by auto
then have "x ∈ set (a) ∨ x ∈ set (ram1 #b) ∨ x ∈ set (ram2 # c)" by auto
then have "x ∈ set (a) ∨ x = ram1 ∨ x ∈ set b ∨ x = ram2 ∨ x ∈ set c" by auto
then have "x ∈ set c ∨ x ∈ set (a) ∨ x = ram1 ∨ x ∈ set b ∨ x = ram2" by auto
then have "x ∈ set (c @ a) ∨ x = ram1 ∨ x ∈ set b ∨ x = ram2" by auto
with b p a_def b_def c_def show ?thesis by auto
qed
lemma
"before vs ram1 ram2 ⟹ pre_between vs ram1 ram2 ⟹
hd vs ≠ ram1 ⟹ (a,b) = splitAt (hd vs) (between vs ram2 ram1) ⟹
vs = [hd vs] @ b @ [ram1] @ (between vs ram1 ram2) @ [ram2] @ a"
proof -
assume b: "before vs ram1 ram2" and p: "pre_between vs ram1 ram2" and vs: "hd vs ≠ ram1" and ab: "(a,b) = splitAt (hd vs) (between vs ram2 ram1)"
from p have dist_b: "distinct (between vs ram2 ram1)" by (auto intro: between_distinct simp: pre_between_def)
with ab have "distinct a ∧ distinct b" by (auto intro: splitAt_distinct_a splitAt_distinct_b)
define r where "r = snd (splitAt ram1 vs)"
define btw where "btw = between vs ram2 ram1"
from p r_def have vs2: "vs = fst (splitAt ram1 vs) @ [ram1] @ r" by (auto dest: splitAt_ram simp: pre_between_def)
then have "fst (splitAt ram1 vs) = [] ⟹ hd vs = ram1" by auto
with vs have neq: "fst (splitAt ram1 vs) ≠ []" by auto
with vs2 have vs_fst: "hd vs = hd (fst (splitAt ram1 vs))" by (induct ("fst (splitAt ram1 vs)")) auto
with neq have "hd vs ∈ set (fst (splitAt ram1 vs))" by auto
with b p have "hd vs ∈ set (between vs ram2 ram1)" by auto
with btw_def have help1: "btw = fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by (auto dest: splitAt_ram)
from p b btw_def have "btw = snd (splitAt ram2 vs) @ fst (splitAt ram1 vs)" by auto
with neq have "btw = snd (splitAt ram2 vs) @ hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs))" by auto
with vs_fst have "btw = snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs))" by auto
with help1 have eq: "snd (splitAt ram2 vs) @ [hd vs] @ tl (fst (splitAt ram1 vs)) = fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw)" by auto
from dist_b btw_def help1 have "distinct (fst (splitAt (hd vs) btw) @ [hd vs] @ snd (splitAt (hd vs) btw))" by auto
with eq have eq2: "snd (splitAt ram2 vs) = fst (splitAt (hd vs) btw) ∧ tl (fst (splitAt ram1 vs)) = snd (splitAt (hd vs) btw)" apply (rule_tac dist_at) by auto
with btw_def ab have a: "a = snd (splitAt ram2 vs)" by (auto dest: pairD)
from eq2 vs_fst have "hd (fst (splitAt ram1 vs)) # tl (fst (splitAt ram1 vs)) = hd vs # snd (splitAt (hd vs) btw)" by auto
with ab btw_def neq have hdb: "hd vs # b = fst (splitAt ram1 vs)" by (auto dest: pairD)
from b p have "vs = fst (splitAt ram1 vs) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" apply simp
apply (rule_tac before_vs) by (auto simp: pre_between_def)
with hdb have "vs = (hd vs # b) @ [ram1] @ fst (splitAt ram2 (snd (splitAt ram1 vs))) @ [ram2] @ snd (splitAt ram2 vs)" by auto
with a b p show ?thesis by (simp)
qed
lemma between_congs: "pre_between vs ram1 ram2 ⟹ vs ≅ vs' ⟹ between vs ram1 ram2 = between vs' ram1 ram2"
proof -
have "⋀ us. pre_between us ram1 ram2 ⟹ before us ram1 ram2 ⟹ between us ram1 ram2 = between (rotate1 us) ram1 ram2"
proof -
fix us
assume vors: "pre_between us ram1 ram2" "before us ram1 ram2"
then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
proof (cases "us")
case Nil then show ?thesis by auto
next
case (Cons u' us')
with vors pb2 show ?thesis apply (auto simp: before_def)
apply (case_tac "a") apply auto
by (simp_all add: between_def split_def pre_between_def)
qed
qed
moreover have "⋀ us. pre_between us ram1 ram2 ⟹ before us ram2 ram1 ⟹ between us ram1 ram2 = between (rotate1 us) ram1 ram2"
proof -
fix us
assume vors: " pre_between us ram1 ram2" "before us ram2 ram1"
then have pb2: "pre_between (rotate1 us) ram1 ram2" by auto
with vors show "between us ram1 ram2 = between (rotate1 us) ram1 ram2"
proof (cases "us")
case Nil then show ?thesis by auto
next
case (Cons u' us')
with vors pb2 show ?thesis apply (auto simp: before_def)
apply (case_tac "a") apply auto
by (simp_all add: between_def split_def pre_between_def)
qed
qed
ultimately have "help": "⋀ us. pre_between us ram1 ram2 ⟹ between us ram1 ram2 = between (rotate1 us) ram1 ram2"
apply (subgoal_tac "before us ram1 ram2 ∨ before us ram2 ram1") by auto
assume "vs ≅ vs'" and pre_b: "pre_between vs ram1 ram2"
then obtain n where vs': "vs' = rotate n vs" by (auto simp: congs_def)
have "between vs ram1 ram2 = between (rotate n vs) ram1 ram2"
proof (induct n)
case 0 then show ?case by auto
next
case (Suc m) then show ?case apply simp
apply (subgoal_tac " between (rotate1 (rotate m vs)) ram1 ram2 = between (rotate m vs) ram1 ram2")
by (auto intro: "help" [symmetric] pre_b)
qed
with vs' show ?thesis by auto
qed
lemma between_inter_empty:
"pre_between vs ram1 ram2 ⟹
set (between vs ram1 ram2) ∩ set (between vs ram2 ram1) = {}"
apply (case_tac "before vs ram1 ram2")
apply (simp add: pre_between_def)
apply (elim conjE)
apply (frule (1) before_vs)
apply (subgoal_tac "distinct (fst (splitAt ram1 vs) @
ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs))")
apply (thin_tac "vs = fst (splitAt ram1 vs) @
ram1 # fst (splitAt ram2 (snd (splitAt ram1 vs))) @ ram2 # snd (splitAt ram2 vs)")
apply (frule (1) before_dist_fst_snd)
apply(simp)
apply blast
apply (simp only:)
apply (simp add: before_xor)
apply (subgoal_tac "pre_between vs ram2 ram1")
apply (simp add: pre_between_def)
apply (elim conjE)
apply (frule (1) before_vs)
apply (subgoal_tac "distinct (fst (splitAt ram2 vs) @
ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs))")
apply (thin_tac "vs = fst (splitAt ram2 vs) @
ram2 # fst (splitAt ram1 (snd (splitAt ram2 vs))) @ ram1 # snd (splitAt ram1 vs)")
apply simp
apply blast
apply (simp only:)
by (rule pre_between_symI)
subsubsection ‹‹between is_nextElem››
lemma is_nextElem_or1: "pre_between vs ram1 ram2 ⟹
is_nextElem vs x y ⟹ before vs ram1 ram2 ⟹
is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2])
∨ is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
proof -
assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y" and b: "before vs ram1 ram2"
from p have r1: "ram1 ∈ set vs" by (auto simp: pre_between_def)
define bs where "bs = [ram1] @ (between vs ram1 ram2) @ [ram2]"
have rule1: "x ∈ set (ram1 # (between vs ram1 ram2)) ⟹ is_sublist [x,y] bs"
proof -
assume xin:"x ∈ set (ram1 # (between vs ram1 ram2))"
with bs_def have xin2: "x ∈ set bs" by auto
define s where "s = snd (splitAt ram1 vs)"
from r1 s_def have sub1:"is_sublist (ram1 # s) vs" by (auto intro: splitAt_is_sublist2R)
from b p s_def have "ram2 ∈ set s" by (auto intro!: before_dist_r2 simp: pre_between_def)
then have "is_prefix (fst (splitAt ram2 s) @ [ram2]) s" by (auto intro!: splitAt_is_prefix)
then have "is_prefix ([ram1] @ ((fst (splitAt ram2 s)) @ [ram2])) ([ram1] @ s)" by (rule_tac is_prefix_add) auto
with sub1 have "is_sublist (ram1 # (fst (splitAt ram2 s)) @ [ram2]) vs" apply (rule_tac is_sublist_trans) apply (rule is_prefix_sublist)
by simp_all
with p b s_def bs_def have subl: "is_sublist bs vs" by (auto)
with p have db: "distinct bs" by (auto simp: pre_between_def)
with xin bs_def have xnlb:"x ≠ last bs" by auto
with p is_nextElem subl xin2 show "is_sublist [x,y] bs" apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
qed
define bs2 where "bs2 = [ram2] @ (between vs ram2 ram1) @ [ram1]"
have rule2: "x ∈ set (ram2 # (between vs ram2 ram1)) ⟹ is_sublist [x,y] bs2"
proof -
assume xin:"x ∈ set (ram2 # (between vs ram2 ram1))"
with bs2_def have xin2: "x ∈ set bs2" by auto
define cs1 where "cs1 = ram2 # snd (splitAt ram2 vs)"
then have cs1ne: "cs1 ≠ []" by auto
define cs2 where "cs2 = fst (splitAt ram1 vs)"
define cs2ram1 where "cs2ram1 = cs2 @ [ram1]"
from cs1_def cs2_def bs2_def p b have bs2: "bs2 = cs1 @ cs2 @ [ram1]" by (auto simp: pre_between_def)
have "x ∈ set cs1 ⟹ x ≠ last cs1 ⟹ is_sublist [x,y] cs1"
proof-
assume xin2: "x ∈ set cs1" and xnlcs1: "x ≠ last cs1"
from cs1_def p have "is_sublist cs1 vs" by (simp add: pre_between_def)
with p is_nextElem xnlcs1 xin2 show ?thesis apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
qed
with bs2 have incs1nl: "x ∈ set cs1 ⟹ x ≠ last cs1 ⟹ is_sublist [x,y] bs2"
apply (auto simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "as @ x # y # bs @ cs2 @ [ram1] = as @ x # y # (bs @ cs2 @ [ram1])")
apply assumption by auto
have "x = last cs1 ⟹ y = hd (cs2 @ [ram1])"
proof -
assume xl: "x = last cs1"
from p have "distinct vs" by auto
with p have "vs = fst (splitAt ram2 vs) @ ram2 # snd (splitAt ram2 vs)" by (auto intro: splitAt_ram)
with cs1_def have "last vs = last (fst (splitAt ram2 vs) @ cs1)" by auto
with cs1ne have "last vs = last cs1" by auto
with xl have "x = last vs" by auto
with p is_nextElem have yhd: "y = hd vs" by auto
from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
with yhd cs2ram1_def cs2_def have yhd2: "y = hd (cs2ram1 @ snd (splitAt ram1 vs))" by auto
from cs2ram1_def have "cs2ram1 ≠ []" by auto
then have "hd (cs2ram1 @ snd(splitAt ram1 vs)) = hd (cs2ram1)" by auto
with yhd2 cs2ram1_def show ?thesis by auto
qed
with bs2 cs1ne have "x = last cs1 ⟹ is_sublist [x,y] bs2"
apply (auto simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "cs1 @ cs2 @ [ram1] = butlast cs1 @ last cs1 # hd (cs2 @ [ram1]) # tl (cs2 @ [ram1])")
apply assumption by auto
with incs1nl have incs1: "x ∈ set cs1 ⟹ is_sublist [x,y] bs2" by auto
have "x ∈ set cs2 ⟹ is_sublist [x,y] (cs2 @ [ram1])"
proof-
assume xin2': "x ∈ set cs2"
then have xin2: "x ∈ set (cs2 @ [ram1])" by auto
define fr2 where "fr2 = snd (splitAt ram1 vs)"
from p have "vs = fst (splitAt ram1 vs) @ ram1 # snd (splitAt ram1 vs)" by (auto intro: splitAt_ram)
with fr2_def cs2_def have "vs = cs2 @ [ram1] @ fr2" by simp
with p xin2' have "x ≠ ram1" by (auto simp: pre_between_def)
then have xnlcs2: "x ≠ last (cs2 @ [ram1])" by auto
from cs2_def p have "is_sublist (cs2 @ [ram1]) vs" by (simp add: pre_between_def)
with p is_nextElem xnlcs2 xin2 show ?thesis apply (rule_tac is_sublist_is_nextElem) by (auto simp: pre_between_def)
qed
with bs2 have "x ∈ set cs2 ⟹ is_sublist [x,y] bs2"
apply (auto simp: is_sublist_def) apply (intro exI)
apply (subgoal_tac "cs1 @ as @ x # y # bs = (cs1 @ as) @ x # y # bs")
apply assumption by auto
with p b cs1_def cs2_def incs1 xin show ?thesis by auto
qed
from is_nextElem have "x ∈ set vs" by auto
with b p have "x = ram1 ∨ x ∈ set (between vs ram1 ram2) ∨ x = ram2 ∨ x ∈ set (between vs ram2 ram1)" by (rule_tac between_in) auto
then have "x ∈ set (ram1 # (between vs ram1 ram2)) ∨ x ∈ set (ram2 # (between vs ram2 ram1))" by auto
with rule1 rule2 bs_def bs2_def show ?thesis by auto
qed
lemma is_nextElem_or: "pre_between vs ram1 ram2 ⟹ is_nextElem vs x y ⟹
is_sublist [x,y] (ram1 # between vs ram1 ram2 @ [ram2]) ∨ is_sublist [x,y] (ram2 # between vs ram2 ram1 @ [ram1])"
proof (cases "before vs ram1 ram2")
case True
assume "pre_between vs ram1 ram2" "is_nextElem vs x y"
with True show ?thesis by (rule_tac is_nextElem_or1)
next
assume p: "pre_between vs ram1 ram2" and is_nextElem: "is_nextElem vs x y"
from p have p': "pre_between vs ram2 ram1" by (auto intro: pre_between_symI)
case False with p have "before vs ram2 ram1" by auto
with p' is_nextElem show ?thesis apply (drule_tac is_nextElem_or1) apply assumption+ by auto
qed
lemma between_eq2:
"pre_between vs ram1 ram2 ⟹
before vs ram2 ram1 ⟹
∃as bs cs. between vs ram1 ram2 = cs @ as ∧ vs = as @[ram2] @ bs @ [ram1] @ cs"
apply (subgoal_tac "pre_between vs ram2 ram1")
apply auto apply (intro exI conjI) apply simp apply (simp add: pre_between_def) apply auto
apply (frule_tac before_vs) apply auto by (auto simp: pre_between_def)
lemma is_sublist_same_len[simp]:
"length xs = length ys ⟹ is_sublist xs ys = (xs = ys)"
apply(cases xs)
apply simp
apply(rename_tac a as)
apply(cases ys)
apply simp
apply(rename_tac b bs)
apply(case_tac "a = b")
apply(subst is_sublist_rec)
apply simp
apply simp
done
lemma is_nextElem_between_empty[simp]:
"distinct vs ⟹ is_nextElem vs a b ⟹ between vs a b = []"
apply (simp add: is_nextElem_def between_def split_def)
apply (cases "vs") apply simp+
apply (simp split: if_split_asm)
apply (case_tac "b = aa")
apply (simp add: is_sublist_def)
apply (erule disjE)
apply (elim exE)
apply (case_tac "as")
apply simp
apply simp
apply simp
apply (case_tac "list" rule: rev_exhaust)
apply simp
apply simp
apply simp
apply (subgoal_tac "aa # list = vs")
apply (thin_tac "vs = aa # list")
apply simp
apply (subgoal_tac "distinct vs")
apply (simp add: is_sublist_def)
apply (elim exE)
by auto
lemma is_nextElem_between_empty': "between vs a b = [] ⟹ distinct vs ⟹ a ∈ set vs ⟹ b ∈ set vs ⟹
a ≠ b ⟹ is_nextElem vs a b"
apply (simp add: is_nextElem_def between_def split_def split: if_split_asm)
apply (case_tac vs) apply simp
apply simp
apply (rule conjI)
apply (rule impI)
apply simp
apply (case_tac "aa = b")
apply simp
apply (rule impI)
apply (case_tac "list" rule: rev_exhaust)
apply simp
apply simp
apply (case_tac "a = y") apply simp
apply simp
apply (elim conjE)
apply (drule split_list_first)
apply (elim exE)
apply simp
apply (rule impI)
apply (subgoal_tac "b ≠ aa")
apply simp
apply (case_tac "a = aa")
apply simp
apply (case_tac "list") apply simp
apply simp
apply (case_tac "aaa = b") apply (simp add: is_sublist_def) apply force
apply simp
apply simp
apply (drule split_list_first)
apply (elim exE)
apply simp
apply (case_tac "zs") apply simp
apply simp
apply (case_tac "aaa = b")
apply simp
apply (simp add: is_sublist_def) apply force
apply simp
apply force
apply (case_tac vs) apply simp
apply simp
apply (rule conjI)
apply (rule impI) apply simp
apply (rule impI)
apply (case_tac "b = aa")
apply simp
apply (case_tac "list" rule: rev_exhaust) apply simp
apply simp
apply (case_tac "a = y") apply simp
apply simp
apply (drule split_list_first)
apply (elim exE)
apply simp
apply simp apply (case_tac "a = aa") by auto
lemma between_nextElem: "pre_between vs u v ⟹
between vs u (nextElem vs (hd vs) v) = between vs u v @ [v]"
apply(subgoal_tac "pre_between vs v u")
prefer 2 apply (clarsimp simp add:pre_between_def)
apply(case_tac "before vs u v")
apply(drule (1) between_eq2)
apply(clarsimp simp:pre_between_def hd_append split:list.split)
apply(simp add:between_def split_def)
apply(fastforce simp:neq_Nil_conv)
apply (simp only:before_xor)
apply(drule (1) between_eq2)
apply(clarsimp simp:pre_between_def hd_append split:list.split)
apply (simp add: append_eq_Cons_conv)
apply(fastforce simp:between_def split_def)
done
lemma nextVertices_in_face[simp]: "v ∈ 𝒱 f ⟹ f⇗n⇖ ∙ v ∈ 𝒱 f"
proof -
assume v: "v ∈ 𝒱 f"
then have f: "vertices f ≠ []" by auto
show ?thesis apply (simp add: nextVertices_def)
apply (induct n) by (auto simp: f v)
qed
subsubsection ‹‹is_nextElem edges› equivalence›
lemma is_nextElem_edges1: "distinct (vertices f) ⟹ (a,b) ∈ edges (f::face) ⟹ is_nextElem (vertices f) a b" apply (simp add: edges_face_def nextVertex_def) apply (rule is_nextElem1) by auto
lemma is_nextElem_edges2:
"distinct (vertices f) ⟹ is_nextElem (vertices f) a b ⟹
(a,b) ∈ edges (f::face)"
apply (auto simp add: edges_face_def nextVertex_def)
apply (rule sym)
apply (rule is_nextElem2) by (auto intro: is_nextElem_a)
lemma is_nextElem_edges_eq[simp]:
"distinct (vertices (f::face)) ⟹
(a,b) ∈ edges f = is_nextElem (vertices f) a b"
by (auto intro: is_nextElem_edges1 is_nextElem_edges2)
subsubsection ‹@{const nextVertex}›
lemma nextElem_suc2: "distinct (vertices f) ⟹ last (vertices f) = v ⟹ v ∈ set (vertices f) ⟹ f ∙ v = hd (vertices f)"
proof -
assume dist: "distinct (vertices f)" and last: "last (vertices f) = v" and v: "v ∈ set (vertices f)"
define ls where "ls = vertices f"
have ind: "⋀ c. distinct ls ⟹ last ls = v ⟹ v ∈ set ls ⟹ nextElem ls c v = c"
proof (induct ls)
case Nil then show ?case by auto
next
case (Cons m ms)
then show ?case
proof (cases "m = v")
case True with Cons have "ms = []" apply (cases ms rule: rev_exhaust) by auto
then show ?thesis by auto
next
case False with Cons have a1: "v ∈ set ms" by auto
then have ms: "ms ≠ []" by auto
with False Cons ms have "nextElem ms c v = c" apply (rule_tac Cons) by simp_all
with False ms show ?thesis by simp
qed
qed
from dist ls_def last v have "nextElem ls (hd ls) v = hd ls" apply (rule_tac ind) by auto
with ls_def show ?thesis by (simp add: nextVertex_def)
qed
subsection ‹@{const split_face}›
definition pre_split_face :: "face ⇒ nat ⇒ nat ⇒ nat list ⇒ bool" where
"pre_split_face oldF ram1 ram2 newVertexList ≡
distinct (vertices oldF) ∧ distinct (newVertexList)
∧ 𝒱 oldF ∩ set newVertexList = {}
∧ ram1 ∈ 𝒱 oldF ∧ ram2 ∈ 𝒱 oldF ∧ ram1 ≠ ram2"
declare pre_split_face_def [simp]
lemma pre_split_face_p_between[intro]:
"pre_split_face oldF ram1 ram2 newVertexList ⟹ pre_between (vertices oldF) ram1 ram2" by (simp add: pre_between_def)
lemma pre_split_face_symI:
"pre_split_face oldF ram1 ram2 newVertexList ⟹ pre_split_face oldF ram2 ram1 newVertexList" by auto
lemma pre_split_face_rev[intro]:
"pre_split_face oldF ram1 ram2 newVertexList ⟹ pre_split_face oldF ram1 ram2 (rev newVertexList)" by auto
lemma split_face_distinct1:
"(f12, f21) = split_face oldF ram1 ram2 newVertexList ⟹ pre_split_face oldF ram1 ram2 newVertexList ⟹
distinct (vertices f12)"
proof -
assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList"
define old_vs where "old_vs = vertices oldF"
with p have d_old_vs: "distinct old_vs" by auto
from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
have rule1: "before old_vs ram1 ram2 ⟹ distinct (vertices f12)"
proof -
assume b: "before old_vs ram1 ram2"
with split p have "f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal" by (simp add: split_face_def)
then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]" by auto
from p have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])" by (auto del: notI)
from b p p2 old_vs_def have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) ∩ set newVertexList = {}"
by (auto dest!: splitAt_in_fst splitAt_in_snd)
with h1 d1 p show ?thesis by auto
qed
have rule2: "before old_vs ram2 ram1 ⟹ distinct (vertices f12)"
proof -
assume b: "before old_vs ram2 ram1"
from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
by (auto intro: pre_split_face_symI)
then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
with split p have
"f12 = Face (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal"
by (simp add: split_face_def)
then have h1:"vertices f12 = rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]"
by auto
from p3 have d1: "distinct(ram1 # between (vertices oldF) ram1 ram2 @ [ram2])"
by (auto del: notI)
from b p3 p4 old_vs_def
have d2: "set (ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) ∩ set newVertexList = {}"
by auto
with h1 d1 p show ?thesis by auto
qed
from p2 rule1 rule2 old_vs_def show ?thesis by auto
qed
lemma split_face_distinct1'[intro]:
"pre_split_face oldF ram1 ram2 newVertexList ⟹
distinct (vertices (fst(split_face oldF ram1 ram2 newVertexList)))"
apply (rule_tac split_face_distinct1)
by (auto simp del: pre_split_face_def simp: split_face_def)
lemma split_face_distinct2:
"(f12, f21) = split_face oldF ram1 ram2 newVertexList ⟹
pre_split_face oldF ram1 ram2 newVertexList ⟹ distinct (vertices f21)"
proof -
assume split: "(f12, f21) = split_face oldF ram1 ram2 newVertexList"
and p: "pre_split_face oldF ram1 ram2 newVertexList"
define old_vs where "old_vs = vertices oldF"
with p have d_old_vs: "distinct old_vs" by auto
with p have p1: "pre_split_face oldF ram1 ram2 newVertexList" by auto
from p have p2: "pre_between (vertices oldF) ram1 ram2" by auto
have rule1: "before old_vs ram1 ram2 ⟹ distinct (vertices f21)"
proof -
assume b: "before old_vs ram1 ram2"
with split p
have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
by (simp add: split_face_def)
then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
by auto
from p have d1: "distinct(ram1 # between (vertices oldF) ram2 ram1 @ [ram2])"
by (auto del: notI)
from b p1 p2 old_vs_def
have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) ∩ set newVertexList = {}"
by auto
with h1 d1 p1 show ?thesis by auto
qed
have rule2: "before old_vs ram2 ram1 ⟹ distinct (vertices f21)"
proof -
assume b: "before old_vs ram2 ram1"
from p have p3: "pre_split_face oldF ram1 ram2 newVertexList"
by (auto intro: pre_split_face_symI)
then have p4: "pre_between (vertices oldF) ram2 ram1" by auto
with split p
have "f21 = Face (ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList) Nonfinal"
by (simp add: split_face_def)
then have h1:"vertices f21 = ram2 # between (vertices oldF) ram2 ram1 @ [ram1] @ newVertexList"
by auto
from p3 have d1: "distinct(ram2 # between (vertices oldF) ram2 ram1 @ [ram1])"
by (auto del: notI)
from b p3 p4 old_vs_def
have d2: "set (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) ∩ set newVertexList = {}"
by auto
with h1 d1 p1 show ?thesis by auto
qed
from p2 rule1 rule2 old_vs_def show ?thesis by auto
qed
lemma split_face_distinct2'[intro]:
"pre_split_face oldF ram1 ram2 newVertexList ⟹ distinct (vertices (snd(split_face oldF ram1 ram2 newVertexList)))"
apply (rule_tac split_face_distinct2) by (auto simp del: pre_split_face_def simp: split_face_def)
declare pre_split_face_def [simp del]
lemma split_face_edges_or: "(f12, f21) = split_face oldF ram1 ram2 newVertexList ⟹ pre_split_face oldF ram1 ram2 newVertexList ⟹ (a, b) ∈ edges oldF ⟹ (a,b) ∈ edges f12 ∨ (a,b) ∈ edges f21"
proof -
assume nf: "(f12, f21) = split_face oldF ram1 ram2 newVertexList" and p: "pre_split_face oldF ram1 ram2 newVertexList" and old:"(a, b) ∈ edges oldF"
from p have d1:"distinct (vertices oldF)" by auto
from nf p have d2: "distinct (vertices f12)" by (auto dest: pairD)
from nf p have d3: "distinct (vertices f21)" by (auto dest: pairD)
from p have p': "pre_between (vertices oldF) ram1 ram2" by auto
from old d1 have is_nextElem: "is_nextElem (vertices oldF) a b" by simp
with p have "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2]) ∨ is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" apply (rule_tac is_nextElem_or) by auto
then have "is_nextElem (rev newVertexList @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) a b
∨ is_nextElem (ram2 # between (vertices oldF) ram2 ram1 @ ram1 # newVertexList) a b"
proof (cases "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])")
case True then show ?thesis by (auto dest: is_sublist_add intro!: is_nextElem_sublistI)
next
case False
assume "is_sublist [a,b] (ram1 # (between (vertices oldF) ram1 ram2) @ [ram2])
∨ is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])"
with False have "is_sublist [a,b] (ram2 # (between (vertices oldF) ram2 ram1) @ [ram1])" by auto
then show ?thesis apply (rule_tac disjI2) apply (rule_tac is_nextElem_sublistI)
apply (subgoal_tac "is_sublist [a, b] ([] @ (ram2 # between (vertices oldF) ram2 ram1 @ [ram1]) @ newVertexList)") apply force by (frule is_sublist_add)
qed
with nf d1 d2 d3 show ?thesis by (simp add: split_face_def)
qed
subsection ‹‹verticesFrom››
definition verticesFrom :: "face ⇒ vertex ⇒ vertex list" where
"verticesFrom f ≡ rotate_to (vertices f)"
lemmas verticesFrom_Def = verticesFrom_def rotate_to_def
lemma len_vFrom[simp]:
"v ∈ 𝒱 f ⟹ |verticesFrom f v| = |vertices f|"
apply(drule split_list_first)
apply(clarsimp simp: verticesFrom_Def)
done
lemma verticesFrom_empty[simp]:
"v ∈ 𝒱 f ⟹ (verticesFrom f v = []) = (vertices f = [])"
by(clarsimp simp: verticesFrom_Def)
lemma verticesFrom_congs:
"v ∈ 𝒱 f ⟹ (vertices f) ≅ (verticesFrom f v)"
by(simp add:verticesFrom_def cong_rotate_to)
lemma verticesFrom_eq_if_vertices_cong:
"⟦distinct(vertices f); distinct(vertices f');
vertices f ≅ vertices f'; x ∈ 𝒱 f ⟧ ⟹
verticesFrom f x = verticesFrom f' x"
by(clarsimp simp:congs_def verticesFrom_Def splitAt_rotate_pair_conv)
lemma verticesFrom_in[intro]: "v ∈ 𝒱 f ⟹ a ∈ 𝒱 f ⟹ a ∈ set (verticesFrom f v)"
by (auto dest: verticesFrom_congs congs_pres_nodes)
lemma verticesFrom_in': "a ∈ set (verticesFrom f v) ⟹ a ≠ v ⟹ a ∈ 𝒱 f"
apply (cases "v ∈ 𝒱 f") apply (auto dest: verticesFrom_congs congs_pres_nodes)
by (simp add: verticesFrom_Def)
lemma set_verticesFrom:
"v ∈ 𝒱 f ⟹ set (verticesFrom f v) = 𝒱 f"
apply(auto)
apply (auto simp add: verticesFrom_Def)
done
lemma verticesFrom_hd: "hd (verticesFrom f v) = v" by (simp add: verticesFrom_Def)
lemma verticesFrom_distinct[simp]: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ distinct (verticesFrom f v)" apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)
lemma verticesFrom_nextElem_eq:
"distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ u ∈ 𝒱 f ⟹
nextElem (verticesFrom f v) (hd (verticesFrom f v)) u
= nextElem (vertices f) (hd (vertices f)) u" apply (subgoal_tac "(verticesFrom f v) ≅ (vertices f)")
apply (rule nextElem_congs_eq) apply (auto simp: verticesFrom_congs congs_pres_nodes) apply (rule congs_sym)
by (simp add: verticesFrom_congs)
lemma nextElem_vFrom_suc1: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ i < length (vertices f) ⟹ last (verticesFrom f v) ≠ u ⟹ (verticesFrom f v)!i = u ⟹ f ∙ u = (verticesFrom f v)!(Suc i)"
proof -
assume dist: "distinct (vertices f)" and ith: "(verticesFrom f v)!i = u" and small_i: "i < length (vertices f)" and notlast: "last (verticesFrom f v) ≠ u" and v: "v ∈ 𝒱 f"
hence eq: "(vertices f) ≅ (verticesFrom f v)" by (auto simp: verticesFrom_congs)
from ith eq small_i have "u ∈ set (verticesFrom f v)" by (auto simp: congs_length)
with eq have u: "u ∈ 𝒱 f" by (auto simp: congs_pres_nodes)
define ls where "ls = verticesFrom f v"
with dist ith have "ls!i = u" by auto
have ind: "⋀ c i. i < length ls ⟹ distinct ls ⟹ last ls ≠ u ⟹ ls!i = u ⟹ u ∈ set ls ⟹
nextElem ls c u = ls ! Suc i"
proof (induct ls)
case Nil then show ?case by auto
next
case (Cons m ms)
then show ?case
proof (cases "m = u")
case True with Cons have "u ∉ set ms" by auto
with Cons True have i: "i = 0" apply (induct i) by auto
with Cons show ?thesis apply (simp split: if_split_asm) apply (cases ms) by simp_all
next
case False with Cons have a1: "u ∈ set ms" by auto
then have ms: "ms ≠ []" by auto
from False Cons have i: "0 < i" by auto
define i' where "i' = i - 1"
with i have i': "i = Suc i'" by auto
with False Cons i' ms have "nextElem ms c u = ms ! Suc i'" apply (rule_tac Cons) by simp_all
with False Cons i' ms show ?thesis by simp
qed
qed
from eq dist ith ls_def small_i notlast v
have "nextElem ls (hd ls) u = ls ! Suc i"
apply (rule_tac ind) by (auto simp: congs_length)
with dist u v ls_def show ?thesis by (simp add: nextVertex_def verticesFrom_nextElem_eq)
qed
lemma verticesFrom_nth: "distinct (vertices f) ⟹ d < length (vertices f) ⟹
v ∈ 𝒱 f ⟹ (verticesFrom f v)!d = f⇗d⇖ ∙ v"
proof (induct d)
case 0 then show ?case by (simp add: verticesFrom_Def nextVertices_def)
next
case (Suc n)
then have dist2: "distinct (verticesFrom f v)"
apply (frule_tac verticesFrom_congs) by (auto simp: congs_distinct)
from Suc have in2: "v ∈ set (verticesFrom f v)"
apply (frule_tac verticesFrom_congs) by (auto dest: congs_pres_nodes)
then have vFrom: "(verticesFrom f v) = butlast (verticesFrom f v) @ [last (verticesFrom f v)]"
apply (cases "(verticesFrom f v)" rule: rev_exhaust) by auto
from Suc show ?case
proof (cases "last (verticesFrom f v) = f⇗n⇖ ∙ v")
case True with Suc have "verticesFrom f v ! n = f⇗n⇖ ∙ v" by (rule_tac Suc) auto
with True have "last (verticesFrom f v) = verticesFrom f v ! n" by auto
with Suc dist2 in2 have "Suc n = length (verticesFrom f v)"
apply (rule_tac nth_last_Suc_n) by auto
with Suc show ?thesis by auto
next
case False with Suc show ?thesis apply (simp add: nextVertices_def) apply (rule sym)
apply (rule_tac nextElem_vFrom_suc1) by simp_all
qed
qed
lemma verticesFrom_length: "distinct (vertices f) ⟹ v ∈ set (vertices f) ⟹
length (verticesFrom f v) = length (vertices f)"
by (auto intro: congs_length verticesFrom_congs)
lemma verticesFrom_between: "v' ∈ 𝒱 f ⟹ pre_between (vertices f) u v ⟹
between (vertices f) u v = between (verticesFrom f v') u v"
by (auto intro!: between_congs verticesFrom_congs)
lemma verticesFrom_is_nextElem: "v ∈ 𝒱 f ⟹
is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b"
apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)
lemma verticesFrom_is_nextElem_last: "v' ∈ 𝒱 f ⟹ distinct (vertices f)
⟹ is_nextElem (verticesFrom f v') (last (verticesFrom f v')) v ⟹ v = v'"
apply (subgoal_tac "distinct (verticesFrom f v')")
apply (subgoal_tac "last (verticesFrom f v') ∈ set (verticesFrom f v')")
apply (simp add: nextElem_is_nextElem)
apply (simp add: verticesFrom_hd)
apply (cases "(verticesFrom f v')" rule: rev_exhaust) apply (simp add: verticesFrom_Def)
by auto
lemma verticesFrom_is_nextElem_hd: "v' ∈ 𝒱 f ⟹ distinct (vertices f)
⟹ is_nextElem (verticesFrom f v') u v' ⟹ u = last (verticesFrom f v')"
apply (subgoal_tac "distinct (verticesFrom f v')")
apply (thin_tac "distinct (vertices f)") apply (auto simp: is_nextElem_def)
apply (drule is_sublist_y_hd) apply (simp add: verticesFrom_hd)
by auto
lemma verticesFrom_pres_nodes1: "v ∈ 𝒱 f ⟹ 𝒱 f = set(verticesFrom f v)"
proof -
assume "v ∈ 𝒱 f"
then have "fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f)) = vertices f"
apply (drule_tac splitAt_ram) by simp
moreover have "set (fst (splitAt v (vertices f)) @ [v] @ snd (splitAt v (vertices f))) = set (verticesFrom f v)"
by (auto simp: verticesFrom_Def)
ultimately show ?thesis by simp
qed
lemma verticesFrom_pres_nodes: "v ∈ 𝒱 f ⟹ w ∈ 𝒱 f ⟹ w ∈ set (verticesFrom f v)"
by (auto dest: verticesFrom_pres_nodes1)
lemma before_verticesFrom: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ w ∈ 𝒱 f ⟹
v ≠ w ⟹ before (verticesFrom f v) v w"
proof -
assume v: "v ∈ 𝒱 f" and w: "w ∈ 𝒱 f" and neq: "v ≠ w"
have "hd (verticesFrom f v) = v" by (rule verticesFrom_hd)
with v have vf:"verticesFrom f v = v # tl (verticesFrom f v)"
apply (frule_tac verticesFrom_pres_nodes1)
apply (cases "verticesFrom f v") by auto
moreover with v w have "w ∈ set (verticesFrom f v)" by (auto simp: verticesFrom_pres_nodes)
ultimately have "w ∈ set (v # tl (verticesFrom f v))" by auto
with neq have "w ∈ set (tl (verticesFrom f v))" by auto
with vf have "verticesFrom f v =
[] @ v # fst (splitAt w (tl (verticesFrom f v))) @ w # snd (splitAt w (tl (verticesFrom f v)))"
by (auto dest: splitAt_ram)
then show ?thesis apply (unfold before_def) by (intro exI)
qed
lemma last_vFrom:
"⟦ distinct(vertices f); x ∈ 𝒱 f ⟧ ⟹ last(verticesFrom f x) = f⇗-1⇖ ∙ x"
apply(frule split_list)
apply(clarsimp simp:prevVertex_def verticesFrom_Def split:list.split)
done
lemma rotate_before_vFrom:
"⟦ distinct(vertices f); r ∈ 𝒱 f; r≠u ⟧ ⟹
before (verticesFrom f r) u v ⟹ before (verticesFrom f v) r u"
using [[linarith_neq_limit = 1]]
apply(frule split_list)
apply(clarsimp simp:verticesFrom_Def)
apply(rename_tac as bs)
apply(clarsimp simp:before_def)
apply(rename_tac xs ys zs)
apply(subst (asm) Cons_eq_append_conv)
apply clarsimp
apply(rename_tac bs')
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(rename_tac as')
apply(erule disjE)
defer
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply(rule_tac x = "bs@as'" in exI)
apply simp
apply clarsimp
apply(subst (asm) append_eq_Cons_conv)
apply(erule disjE)
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply simp apply blast
apply clarsimp
apply(rename_tac ys')
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(rename_tac vs')
apply(erule disjE)
apply clarsimp
apply(subst (asm) append_eq_Cons_conv)
apply(erule disjE)
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply simp apply blast
apply clarsimp
apply(rule_tac x = "v#ys'@as" in exI)
apply simp apply blast
apply clarsimp
apply(rule_tac x = "v#zs" in exI)
apply simp apply blast
done
lemma before_between:
"⟦ before(verticesFrom f x) y z; distinct(vertices f); x ∈ 𝒱 f; x ≠ y ⟧ ⟹
y ∈ set(between (vertices f) x z)"
apply(induct f)
apply(clarsimp simp:verticesFrom_Def before_def)
apply(frule split_list)
apply(clarsimp simp:Cons_eq_append_conv)
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(erule disjE)
apply(clarsimp simp:append_eq_Cons_conv)
prefer 2 apply(clarsimp simp add:between_def split_def)
apply(erule disjE)
apply (clarsimp simp:between_def split_def)
apply clarsimp
apply(subst (asm) append_eq_append_conv2)
apply clarsimp
apply(erule disjE)
prefer 2 apply(clarsimp simp add:between_def split_def)
apply(clarsimp simp:append_eq_Cons_conv)
apply(fastforce simp:between_def split_def)
done
lemma before_between2:
"⟦ before (verticesFrom f u) v w; distinct(vertices f); u ∈ 𝒱 f ⟧
⟹ u = v ∨ u ∈ set (between (vertices f) w v)"
apply(subgoal_tac "pre_between (vertices f) v w")
apply(subst verticesFrom_between)
apply assumption
apply(erule pre_between_symI)
apply(frule pre_between_r1)
apply(drule (1) verticesFrom_distinct)
using verticesFrom_hd[of f u]
apply(clarsimp simp add:before_def between_def split_def hd_append
split:if_split_asm)
apply(frule (1) verticesFrom_distinct)
apply(clarsimp simp:pre_between_def before_def simp del:verticesFrom_distinct)
apply(rule conjI)
apply(cases "v = u")
apply simp
apply(rule verticesFrom_in'[of v f u])apply simp apply assumption
apply(cases "w = u")
apply simp
apply(rule verticesFrom_in'[of w f u])apply simp apply assumption
done
subsection ‹@{const splitFace}›
definition pre_splitFace :: "graph ⇒ vertex ⇒ vertex ⇒ face ⇒ vertex list ⇒ bool" where
"pre_splitFace g ram1 ram2 oldF nvs ≡
oldF ∈ ℱ g ∧ ¬ final oldF ∧ distinct (vertices oldF) ∧ distinct nvs
∧ 𝒱 g ∩ set nvs = {}
∧ 𝒱 oldF ∩ set nvs = {}
∧ ram1 ∈ 𝒱 oldF ∧ ram2 ∈ 𝒱 oldF
∧ ram1 ≠ ram2
∧ (((ram1,ram2) ∉ edges oldF ∧ (ram2,ram1) ∉ edges oldF
∧ (ram1, ram2) ∉ edges g ∧ (ram2, ram1) ∉ edges g) ∨ nvs ≠ [])"
declare pre_splitFace_def [simp]
lemma pre_splitFace_pre_split_face[simp]:
"pre_splitFace g ram1 ram2 oldF nvs ⟹ pre_split_face oldF ram1 ram2 nvs"
by (simp add: pre_splitFace_def pre_split_face_def)
lemma pre_splitFace_oldF[simp]:
"pre_splitFace g ram1 ram2 oldF nvs ⟹ oldF ∈ ℱ g"
apply (unfold pre_splitFace_def) by force
declare pre_splitFace_def [simp del]
lemma splitFace_split_face:
"oldF ∈ ℱ g ⟹
(f⇩1, f⇩2, newGraph) = splitFace g ram⇩1 ram⇩2 oldF newVs ⟹
(f⇩1, f⇩2) = split_face oldF ram⇩1 ram⇩2 newVs"
by (simp add: splitFace_def split_def)
lemma split_face_empty_ram2_ram1_in_f12:
"pre_split_face oldF ram1 ram2 [] ⟹
(f12, f21) = split_face oldF ram1 ram2 [] ⟹ (ram2, ram1) ∈ edges f12"
proof -
assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
"pre_split_face oldF ram1 ram2 []"
then have "ram2 ∈ 𝒱 f12" by (simp add: split_face_def)
moreover with split have "f12 ∙ ram2 = hd (vertices f12)"
apply (rule_tac nextElem_suc2)
apply (simp add: pre_split_face_def split_face_distinct1)
by (simp add: split_face_def)
with split have "ram1 = f12 ∙ ram2"
by (simp add: split_face_def)
ultimately show ?thesis by (simp add: edges_face_def)
qed
lemma split_face_empty_ram2_ram1_in_f12':
"pre_split_face oldF ram1 ram2 [] ⟹
(ram2, ram1) ∈ edges (fst (split_face oldF ram1 ram2 []))"
proof -
assume split: "pre_split_face oldF ram1 ram2 []"
define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
with split have "(ram2, ram1) ∈ edges f12"
by (rule split_face_empty_ram2_ram1_in_f12)
with f12_def show ?thesis by simp
qed
lemma splitFace_empty_ram2_ram1_in_f12:
"pre_splitFace g ram1 ram2 oldF [] ⟹
(f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] ⟹
(ram2, ram1) ∈ edges f12"
proof -
assume pre: "pre_splitFace g ram1 ram2 oldF []"
then have oldF: "oldF ∈ ℱ g" by (unfold pre_splitFace_def) simp
assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
by (rule splitFace_split_face)
with pre sp show ?thesis
apply (unfold splitFace_def pre_splitFace_def)
apply (simp add: split_def)
apply (rule split_face_empty_ram2_ram1_in_f12')
apply (rule pre_splitFace_pre_split_face)
apply (rule pre)
done
qed
lemma splitFace_f12_new_vertices:
"(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs ⟹
v ∈ set newVs ⟹ v ∈ 𝒱 f12"
apply (unfold splitFace_def)
apply (simp add: split_def)
apply (unfold split_face_def Let_def)
by simp
lemma splitFace_add_vertices_direct[simp]:
"vertices (snd (snd (splitFace g ram1 ram2 oldF [countVertices g ..< countVertices g + n])))
= vertices g @ [countVertices g ..< countVertices g + n]"
apply (auto simp: splitFace_def split_def) apply (cases g)
apply auto apply (induct n) by auto
lemma splitFace_delete_oldF:
" (f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList ⟹
oldF ≠ f12 ⟹ oldF ≠ f21 ⟹ distinct (faces g) ⟹
oldF ∉ ℱ newGraph"
by (simp add: splitFace_def split_def distinct_set_replace)
lemma splitFace_faces_1:
"(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVertexList ⟹
oldF ∈ ℱ g ⟹
set (faces newGraph) ∪ {oldF} = {f12, f21} ∪ set (faces g)"
(is "?oldF ⟹ ?C ⟹ ?A = ?B")
proof (intro equalityI subsetI)
fix x
assume "x ∈ ?A" and "?C" and "?oldF"
then show "x ∈ ?B" apply (simp add: splitFace_def split_def) by (auto dest: replace1)
next
fix x
assume "x ∈ ?B" and "?C" and "?oldF"
then show "x ∈ ?A" apply (simp add: splitFace_def split_def)
apply (cases "x = oldF") apply simp_all
apply (cases "x = f12") apply simp_all
apply (cases "x = f21") by (auto intro: replace3 replace4)
qed
lemma splitFace_distinct1[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList ⟹
distinct (vertices (fst (snd (splitFace g ram1 ram2 oldF newVertexList))))"
apply (unfold splitFace_def split_def)
by (auto simp add: split_def)
lemma splitFace_distinct2[intro]:"pre_splitFace g ram1 ram2 oldF newVertexList ⟹
distinct (vertices (fst (splitFace g ram1 ram2 oldF newVertexList)))"
apply (unfold splitFace_def split_def)
by (auto simp add: split_def)
lemma splitFace_add_f21': "f' ∈ ℱ g' ⟹ fst (snd (splitFace g' v a f' nvl))
∈ ℱ (snd (snd (splitFace g' v a f' nvl)))"
apply (simp add: splitFace_def split_def) apply (rule disjI2)
apply (rule replace3) by simp_all
lemma split_face_help[simp]: "Suc 0 < |vertices (fst (split_face f' v a nvl))|"
by (simp add: split_face_def)
lemma split_face_help'[simp]: "Suc 0 < |vertices (snd (split_face f' v a nvl))|"
by (simp add: split_face_def)
lemma splitFace_split: "f ∈ ℱ (snd (snd (splitFace g v a f' nvl))) ⟹
f ∈ ℱ g
∨ f = fst (splitFace g v a f' nvl)
∨ f = (fst (snd (splitFace g v a f' nvl)))"
apply (simp add: splitFace_def split_def)
apply safe by (frule replace5) simp
lemma pre_FaceDiv_between1: "pre_splitFace g' ram1 ram2 f [] ⟹
¬ between (vertices f) ram1 ram2 = []"
proof -
assume pre_f: "pre_splitFace g' ram1 ram2 f []"
then have pre_bet: "pre_between (vertices f) ram1 ram2" apply (unfold pre_splitFace_def)
by (simp add: pre_between_def)
then have pre_bet': "pre_between (verticesFrom f ram1) ram1 ram2"
by (simp add: pre_between_def set_verticesFrom)
from pre_f have dist': "distinct (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by simp
from pre_f have ram2: "ram2 ∈ 𝒱 f" apply (unfold pre_splitFace_def) by simp
from pre_f have "¬ is_nextElem (vertices f) ram1 ram2" apply (unfold pre_splitFace_def) by auto
with pre_f have "¬ is_nextElem (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
by (simp add: verticesFrom_is_nextElem [symmetric])
moreover
from pre_f have "ram2 ∈ set (verticesFrom f ram1)" apply (unfold pre_splitFace_def) by auto
moreover
from pre_f have "ram2 ≠ ram1" apply (unfold pre_splitFace_def) by auto
ultimately have ram2_not: "ram2 ≠ hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
apply (simp add: is_nextElem_def verticesFrom_Def)
apply (cases "snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f))")
apply simp apply simp
apply (simp add: is_sublist_def) by auto
from pre_f have before: "before (verticesFrom f ram1) ram1 ram2" apply (unfold pre_splitFace_def)
apply safe apply (rule before_verticesFrom) by auto
have "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = [] ⟹ False"
proof -
assume "fst (splitAt ram2 (snd (splitAt ram1 (verticesFrom f ram1)))) = []"
moreover
from ram2 pre_f have "ram2 ∈ set (verticesFrom f ram1)"apply (unfold pre_splitFace_def)
by auto
with pre_f have "ram2 ∈ set (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
apply (simp add: verticesFrom_Def)
apply (unfold pre_splitFace_def) by auto
moreover
note dist'
ultimately have "ram2 = hd (snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))"
apply (rule_tac ccontr)
apply (cases "(snd (splitAt ram1 (vertices f)) @ fst (splitAt ram1 (vertices f)))")
apply simp
apply simp
by (simp add: verticesFrom_Def del: distinct_append)
with ram2_not show ?thesis by auto
qed
with before pre_bet' have "between (verticesFrom f ram1) ram1 ram2 ≠ []" by auto
with pre_f pre_bet show ?thesis apply (unfold pre_splitFace_def) apply safe
by (simp add: verticesFrom_between)
qed
lemma pre_FaceDiv_between2: "pre_splitFace g' ram1 ram2 f [] ⟹
¬ between (vertices f) ram2 ram1 = []"
proof -
assume pre_f: "pre_splitFace g' ram1 ram2 f []"
then have "pre_splitFace g' ram2 ram1 f []" apply (unfold pre_splitFace_def) by auto
then show ?thesis by (rule pre_FaceDiv_between1)
qed
definition Edges :: "vertex list ⇒ (vertex × vertex) set" where
"Edges vs ≡ {(a,b). is_sublist [a,b] vs}"
lemma Edges_Nil[simp]: "Edges [] = {}"
by(simp add:Edges_def is_sublist_def)
lemma Edges_rev:
"Edges (rev (zs::vertex list)) = {(b,a). (a,b) ∈ Edges zs}"
by (auto simp add: Edges_def is_sublist_rev)
lemma in_Edges_rev[simp]:
"((a,b) : Edges (rev (zs::vertex list))) = ((b,a) ∈ Edges zs)"
by (simp add: Edges_rev)
lemma notinset_notinEdge1: "x ∉ set xs ⟹ (x,y) ∉ Edges xs"
by(unfold Edges_def)(blast intro:is_sublist_in)
lemma notinset_notinEdge2: "y ∉ set xs ⟹ (x,y) ∉ Edges xs"
by(unfold Edges_def)(blast intro:is_sublist_in1)
lemma in_Edges_in_set: "(x,y) : Edges vs ⟹ x ∈ set vs ∧ y ∈ set vs"
by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)
lemma edges_conv_Edges:
"distinct(vertices(f::face)) ⟹ ℰ f =
Edges (vertices f) ∪
(if vertices f = [] then {} else {(last(vertices f), hd(vertices f))})"
by(induct f) (auto simp: Edges_def is_nextElem_def)
lemma Edges_Cons: "Edges(x#xs) =
(if xs = [] then {} else Edges xs ∪ {(x,hd xs)})"
apply(auto simp:Edges_def)
apply(rule ccontr)
apply(simp)
apply(erule thin_rl)
apply(erule contrapos_np)
apply(clarsimp simp:is_sublist_def Cons_eq_append_conv)
apply(rename_tac as bs)
apply(erule disjE)
apply simp
apply(clarsimp)
apply(rename_tac cs)
apply(rule_tac x = cs in exI)
apply(rule_tac x = bs in exI)
apply(rule HOL.refl)
apply(clarsimp simp:neq_Nil_conv)
apply(subst is_sublist_rec)
apply simp
apply(simp add:is_sublist_def)
apply(erule exE)+
apply(rename_tac as bs)
apply simp
apply(rule_tac x = "x#as" in exI)
apply(rule_tac x = bs in exI)
apply simp
done
lemma Edges_append: "Edges(xs @ ys) =
(if xs = [] then Edges ys else
if ys = [] then Edges xs else
Edges xs ∪ Edges ys ∪ {(last xs, hd ys)})"
apply(induct xs)
apply simp
apply (simp add:Edges_Cons)
apply blast
done
lemma Edges_rev_disj: "distinct xs ⟹ Edges(rev xs) ∩ Edges(xs) = {}"
apply(induct xs)
apply simp
apply(auto simp:Edges_Cons Edges_append last_rev
notinset_notinEdge1 notinset_notinEdge2)
done
lemma disj_sets_disj_Edges:
"set xs ∩ set ys = {} ⟹ Edges xs ∩ Edges ys = {}"
by(unfold Edges_def)(blast intro:is_sublist_in is_sublist_in1)
lemma disj_sets_disj_Edges2:
"set ys ∩ set xs = {} ⟹ Edges xs ∩ Edges ys = {}"
by(blast intro!:disj_sets_disj_Edges)
lemma finite_Edges[iff]: "finite(Edges xs)"
by(induct xs)(simp_all add:Edges_Cons)
lemma Edges_compl:
"⟦ distinct vs; x ∈ set vs; y ∈ set vs; x ≠ y ⟧ ⟹
Edges(x # between vs x y @ [y]) ∩ Edges(y # between vs y x @ [x]) = {}"
using [[linarith_neq_limit = 1]]
apply(subgoal_tac
"⋀xs (ys::vertex list). xs ≠ [] ⟹ set xs ∩ set ys = {} ⟹ hd xs ∉ set ys")
prefer 2 apply(drule hd_in_set) apply(blast)
apply(frule split_list[of x])
apply clarsimp
apply(erule disjE)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append
notinset_notinEdge1 notinset_notinEdge2
disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply(fastforce)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply fastforce
done
lemma Edges_disj:
"⟦ distinct vs; x ∈ set vs; z ∈ set vs; x ≠ y; y ≠ z;
y ∈ set(between vs x z) ⟧ ⟹
Edges(x # between vs x y @ [y]) ∩ Edges(y # between vs y z @ [z]) = {}"
apply(subgoal_tac
"⋀xs (ys::vertex list). xs ≠ [] ⟹ set xs ∩ set ys = {} ⟹ hd xs ∉ set ys")
prefer 2 apply(drule hd_in_set) apply(blast)
apply(frule split_list[of x])
apply clarsimp
apply(erule disjE)
apply simp
apply(drule inbetween_inset)
apply(rule Edges_compl)
apply simp
apply simp
apply simp
apply simp
apply(erule disjE)
apply(frule split_list[of z])
apply(clarsimp simp add:between_def split_def)
apply(erule disjE)
apply(frule split_list[of y])
apply clarsimp
apply (clarsimp simp add:Edges_Cons Edges_append
notinset_notinEdge1 notinset_notinEdge2
disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply fastforce
apply(frule split_list[of y])
apply clarsimp
apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply fastforce
apply(frule split_list[of z])
apply(clarsimp simp add:between_def split_def)
apply(frule split_list[of y])
apply clarsimp
apply (clarsimp simp add:Edges_Cons Edges_append notinset_notinEdge1
notinset_notinEdge2 disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply fastforce
done
lemma edges_conv_Un_Edges:
"⟦ distinct(vertices(f::face)); x ∈ 𝒱 f; y ∈ 𝒱 f; x ≠ y ⟧ ⟹
ℰ f = Edges(x # between (vertices f) x y @ [y]) ∪
Edges(y # between (vertices f) y x @ [x])"
apply(simp add:edges_conv_Edges)
apply(rule conjI)
apply clarsimp
apply clarsimp
apply(frule split_list[of x])
apply clarsimp
apply(erule disjE)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append
notinset_notinEdge1 notinset_notinEdge2
disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply(fastforce)
apply(frule split_list[of y])
apply(clarsimp simp add:between_def split_def)
apply (clarsimp simp add:Edges_Cons Edges_append
notinset_notinEdge1 notinset_notinEdge2
disj_sets_disj_Edges disj_sets_disj_Edges2
Int_Un_distrib Int_Un_distrib2)
apply(fastforce)
done
lemma Edges_between_edges:
"⟦ (a,b) ∈ Edges (u # between (vertices(f::face)) u v @ [v]);
pre_split_face f u v vs ⟧ ⟹ (a,b) ∈ ℰ f"
apply(simp add:pre_split_face_def)
apply(induct f)
apply(simp add:edges_conv_Edges Edges_Cons)
apply clarify
apply(rename_tac list)
apply(case_tac "between list u v = []")
apply simp
apply(drule (4) is_nextElem_between_empty')
apply(simp add:Edges_def)
apply(subgoal_tac "pre_between list u v")
prefer 2 apply (simp add:pre_between_def)
apply(subgoal_tac "pre_between list v u")
prefer 2 apply (simp add:pre_between_def)
apply(case_tac "before list u v")
apply(drule (1) between_eq2)
apply clarsimp
apply(erule disjE)
apply (clarsimp simp:neq_Nil_conv)
apply(rule is_nextElem_sublistI)
apply(simp (no_asm) add:is_sublist_def)
apply blast
apply(rule is_nextElem_sublistI)
apply(clarsimp simp add:Edges_def is_sublist_def)
apply(rename_tac as bs cs xs ys)
apply(rule_tac x = "as @ u # xs" in exI)
apply(rule_tac x = "ys @ cs" in exI)
apply simp
apply (simp only:before_xor)
apply(drule (1) between_eq2)
apply clarsimp
apply(rename_tac as bs cs)
apply(erule disjE)
apply (clarsimp simp:neq_Nil_conv)
apply(case_tac cs)
apply clarsimp
apply(simp add:is_nextElem_def)
apply simp
apply(rule is_nextElem_sublistI)
apply(simp (no_asm) add:is_sublist_def)
apply(rule_tac x = "as @ v # bs" in exI)
apply simp
apply(rule_tac m1 = "|as|+1" in is_nextElem_rotate_eq[THEN iffD1])
apply simp
apply(simp add:rotate_drop_take)
apply(rule is_nextElem_sublistI)
apply(clarsimp simp add:Edges_def is_sublist_def)
apply(rename_tac xs ys)
apply(rule_tac x = "bs @ u # xs" in exI)
apply simp
done
lemma edges_split_face1: "pre_split_face f u v vs ⟹
ℰ(fst(split_face f u v vs)) =
Edges(v # rev vs @ [u]) ∪ Edges(u # between (vertices f) u v @ [v])"
apply(simp add: edges_conv_Edges split_face_distinct1')
apply(auto simp add:split_face_def Edges_Cons Edges_append)
done
lemma edges_split_face2: "pre_split_face f u v vs ⟹
ℰ(snd(split_face f u v vs)) =
Edges(u # vs @ [v]) ∪ Edges(v # between (vertices f) v u @ [u])"
apply(simp add: edges_conv_Edges split_face_distinct2')
apply(auto simp add:split_face_def Edges_Cons Edges_append)
done
lemma split_face_empty_ram1_ram2_in_f21:
"pre_split_face oldF ram1 ram2 [] ⟹
(f12, f21) = split_face oldF ram1 ram2 [] ⟹ (ram1, ram2) ∈ edges f21"
proof -
assume split: "(f12, f21) = split_face oldF ram1 ram2 []"
"pre_split_face oldF ram1 ram2 []"
then have "ram1 ∈ 𝒱 f21" by (simp add: split_face_def)
moreover with split have "f21 ∙ ram1 = hd (vertices f21)"
apply (rule_tac nextElem_suc2)
apply (simp add: pre_split_face_def split_face_distinct2)
by (simp add: split_face_def)
with split have "ram2 = f21 ∙ ram1"
by (simp add: split_face_def)
ultimately show ?thesis by (simp add: edges_face_def)
qed
lemma split_face_empty_ram1_ram2_in_f21':
"pre_split_face oldF ram1 ram2 [] ⟹
(ram1, ram2) ∈ edges (snd (split_face oldF ram1 ram2 []))"
proof -
assume split: "pre_split_face oldF ram1 ram2 []"
define f12 where "f12 = fst (split_face oldF ram1 ram2 [])"
define f21 where "f21 = snd (split_face oldF ram1 ram2 [])"
then have "(f12, f21) = split_face oldF ram1 ram2 []" by (simp add: f12_def f21_def)
with split have "(ram1, ram2) ∈ edges f21"
by (rule split_face_empty_ram1_ram2_in_f21)
with f21_def show ?thesis by simp
qed
lemma splitFace_empty_ram1_ram2_in_f21:
"pre_splitFace g ram1 ram2 oldF [] ⟹
(f12, f21, newGraph) = splitFace g ram1 ram2 oldF [] ⟹
(ram1, ram2) ∈ edges f21"
proof -
assume pre: "pre_splitFace g ram1 ram2 oldF []"
then have oldF: "oldF ∈ ℱ g" by (unfold pre_splitFace_def) simp
assume sp: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF []"
with oldF have "(f12, f21) = split_face oldF ram1 ram2 []"
by (rule splitFace_split_face)
with pre sp show ?thesis
apply (unfold splitFace_def pre_splitFace_def)
apply (simp add: split_def)
apply (rule split_face_empty_ram1_ram2_in_f21')
apply (rule pre_splitFace_pre_split_face)
apply (rule pre)
done
qed
lemma splitFace_f21_new_vertices:
"(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs ⟹
v ∈ set newVs ⟹ v ∈ 𝒱 f21"
apply (unfold splitFace_def)
apply (simp add: split_def)
apply (unfold split_face_def)
by simp
lemma split_face_edges_f12:
assumes vors: "pre_split_face f ram1 ram2 vs"
"(f12, f21) = split_face f ram1 ram2 vs"
"vs ≠ []" "vs1 = between (vertices f) ram1 ram2" "vs1 ≠ []"
shows "edges f12 =
{(hd vs, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, last vs)} ∪
Edges(rev vs) ∪ Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
apply (case_tac "c = ram2 ∧ d = last vs") apply simp apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "between (vertices f) ram1 ram2 @ [ram2] = d # bs")
apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
apply (rule dist_at2) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (case_tac "c ∈ set(rev vs)")
apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac "zs") apply simp
apply (subgoal_tac "ys = as") apply(drule last_rev) apply (simp)
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp
apply simp
apply (simp add:rev_swap)
apply (subgoal_tac "ys = as")
apply (clarsimp simp add: Edges_def is_sublist_def)
apply (rule conjI)
apply (subgoal_tac "∃as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
apply (subgoal_tac "∃asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp apply (intro exI) apply simp
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (simp add: pre_split_face_def)
apply (case_tac "c ∈ set (between (vertices f) ram1 ram2)")
apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac zs) apply simp apply (subgoal_tac "rev vs @ ram1 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply simp
apply (subgoal_tac "rev vs @ ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
apply (subgoal_tac "(rev vs @ ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
apply (rule impI) apply (rule disjI2)+ apply force
apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
apply (subgoal_tac "distinct (vertices f12)") apply simp
apply (rule dist_f12)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 = as") apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2])")
apply (thin_tac "rev vs @ ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = ram2 ∧ d = last vs") apply simp
apply (rule disjCI) apply simp
apply (case_tac "c = hd vs ∧ d = ram1")
apply (case_tac "vs") apply simp
apply force
apply simp
apply (case_tac "c = ram1 ∧ d = hd (between (vertices f) ram1 ram2)")
apply (case_tac "between (vertices f) ram1 ram2") apply simp apply force
apply simp
apply (case_tac "c = last (between (vertices f) ram1 ram2) ∧ d = ram2")
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
apply simp
apply (intro exI) apply (subgoal_tac "rev vs @ ram1 # ys @ [y, ram2] = (rev vs @ ram1 # ys) @ y # ram2 # []")
apply assumption
apply simp
apply simp
apply (case_tac "(d,c) ∈ Edges vs") apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (intro exI) apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (intro exI)
apply (subgoal_tac "rev vs @ ram1 # as @ c # d # bs @ [ram2] = (rev vs @ ram1 # as) @ c # d # bs @ [ram2]")
apply assumption
by simp
qed
lemma split_face_edges_f12_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
"(f12, f21) = split_face f ram1 ram2 []"
"vs1 = between (vertices f) ram1 ram2" "vs1 ≠ []"
shows "edges f12 = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} ∪
Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
apply (case_tac " c = ram2 ∧ d = ram1") apply simp
apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "as = []") apply simp
apply (case_tac "between (vertices f) ram1 ram2") apply simp
apply simp
apply (rule dist_at1) apply (rule dist_f12) apply force apply (rule sym) apply simp
apply (case_tac "c ∈ set (between (vertices f) ram1 ram2)")
apply (subgoal_tac "distinct (between (vertices f) ram1 ram2)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac zs) apply simp apply (subgoal_tac "ram1 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply simp
apply (subgoal_tac "ram1 # ys = as") apply (simp add: Edges_def is_sublist_def)
apply (subgoal_tac "(ram1 # ys) @ c # a # list @ [ram2] = as @ c # d # bs") apply simp
apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply (rule exI) apply force
apply (rule impI) apply (rule disjI2)+ apply force
apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs")
apply (subgoal_tac "distinct (vertices f12)") apply simp
apply (rule dist_f12)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 = as") apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
apply (thin_tac "ram1 # between (vertices f) ram1 ram2 @ [ram2] = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = ram2 ∧ d = ram1") apply simp
apply (rule disjCI) apply simp
apply (case_tac "c = ram1 ∧ d = hd (between (vertices f) ram1 ram2)")
apply (case_tac "between (vertices f) ram1 ram2") apply simp
apply force
apply simp
apply (case_tac "c = last (between (vertices f) ram1 ram2) ∧ d = ram2")
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
apply simp
apply (intro exI) apply (subgoal_tac "ram1 # ys @ [y, ram2] = (ram1 # ys) @ y # ram2 # []")
apply assumption
apply simp
apply simp
apply (case_tac "(c, d) ∈ Edges vs") apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (intro exI)
apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # (bs @ [ram2])") apply assumption
apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (intro exI)
apply (subgoal_tac "ram1 # as @ c # d # bs @ [ram2] = (ram1 # as) @ c # d # bs @ [ram2]")
apply assumption
by simp
qed
lemma split_face_edges_f12_bet:
assumes vors: "pre_split_face f ram1 ram2 vs"
"(f12, f21) = split_face f ram1 ram2 vs"
"vs ≠ []" "between (vertices f) ram1 ram2 = []"
shows "edges f12 = {(hd vs, ram1) , (ram1, ram2), (ram2, last vs)} ∪
Edges(rev vs)" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
apply (case_tac " c = ram2 ∧ d = last vs") apply simp
apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "rev vs = as") apply simp
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (case_tac "c ∈ set(rev vs)")
apply (subgoal_tac "distinct(rev vs)") apply (simp only: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac "zs") apply simp apply (subgoal_tac "ys = as") apply (simp add:rev_swap)
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp apply simp
apply (subgoal_tac "ys = as") apply (simp add: Edges_def is_sublist_def rev_swap)
apply (rule conjI)
apply (subgoal_tac "∃as bs. rev list @ [d, c] = as @ d # c # bs") apply simp apply (intro exI) apply simp
apply (subgoal_tac "∃asa bs. rev list @ d # c # rev as = asa @ d # c # bs") apply simp apply (intro exI) apply simp
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (simp add: pre_split_face_def)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "rev vs @ [ram1] = as") apply force
apply (rule dist_at1) apply (rule dist_f12) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (rev vs @ ram1 # [ram2])")
apply (thin_tac "rev vs @ ram1 # [ram2] = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?lhs"
apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = hd vs ∧ d = ram1")
apply (case_tac "vs") apply simp
apply force
apply simp
apply (case_tac "c = ram1 ∧ d = ram2") apply force
apply simp
apply (case_tac "c = ram2 ∧ d = last vs")
apply (case_tac "vs" rule:rev_exhaust) apply simp
apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (rule conjI)
apply (rule impI) apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "c # d # rev as @ [ram1, ram2] = [] @ c # d # rev as @ [ram1,ram2]") apply assumption apply simp
apply (rule impI) apply (rule disjI1) apply (intro exI) by simp
qed
lemma split_face_edges_f12_bet_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
"(f12, f21) = split_face f ram1 ram2 []"
"between (vertices f) ram1 ram2 = []"
shows "edges f12 = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f12)
apply (case_tac " c = ram2 ∧ d = ram1") apply force
apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (case_tac "as") apply simp
apply (case_tac "list") apply simp apply simp
apply (case_tac "as") apply simp apply (case_tac "list") apply simp by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f12: "distinct (vertices f12)" apply (rule_tac split_face_distinct1) by auto
from x vors show "x ∈ ?lhs"
apply (simp add: dist_f12 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
by auto
qed
lemma split_face_edges_f12_subset: "pre_split_face f ram1 ram2 vs ⟹
(f12, f21) = split_face f ram1 ram2 vs ⟹ vs ≠ [] ⟹
{(hd vs, ram1), (ram2, last vs)} ∪ Edges(rev vs) ⊆ edges f12"
apply (case_tac "between (vertices f) ram1 ram2")
apply (frule split_face_edges_f12_bet) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f12) apply simp+ by force
lemma split_face_edges_f21:
assumes vors: "pre_split_face f ram1 ram2 vs"
"(f12, f21) = split_face f ram1 ram2 vs"
"vs ≠ []" "vs2 = between (vertices f) ram2 ram1" "vs2 ≠ []"
shows "edges f21 = {(last vs2, ram1) , (ram1, hd vs), (last vs, ram2), (ram2, hd vs2)} ∪
Edges vs ∪ Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
apply (case_tac " c = last vs ∧ d = ram2") apply simp
apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
apply clarsimp
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (case_tac "c ∈ set vs")
apply (subgoal_tac "distinct vs")
apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac "zs") apply simp
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply simp
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys = as")
apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1 @ ram1 # ys) @ c # a # list = as @ c # d # bs")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # ys @ c # a # list = as @ c # d # bs")
apply (simp add: Edges_def is_sublist_def)
apply(rule conjI)
apply (subgoal_tac "∃as bs. ys @ [c, d] = as @ c # d # bs") apply simp apply force
apply force
apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (simp add: pre_split_face_def)
apply (case_tac "c ∈ set (between (vertices f) ram2 ram1)")
apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply simp
apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
apply (subgoal_tac "(ram2 # ys) @ c # a # list @ ram1 # vs = as @ c # d # bs")
apply (thin_tac "ram2 # ys @ c # a # list @ ram1 # vs = as @ c # d # bs")
apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
apply (rule impI) apply (rule disjI2)+ apply force
apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (subgoal_tac "distinct (vertices f21)")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
apply (rule dist_f21)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (ram2 # between (vertices f) ram2 ram1 @ ram1 # vs)")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = ram2 ∧ d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # vs =
[] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ ram1 # vs") apply assumption apply simp
apply (case_tac "c = ram1 ∧ d = hd vs") apply (rule disjI1)
apply (case_tac "vs") apply simp
apply simp apply (intro exI)
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # a # list =
(ram2 # between (vertices f) ram2 ram1) @ ram1 # a # list") apply assumption apply simp
apply (case_tac "c = last vs ∧ d = ram2")
apply (case_tac vs rule:rev_exhaust) apply simp
apply simp
apply simp
apply (case_tac "c = last (between (vertices f) ram2 ram1) ∧ d = ram1") apply (rule disjI1)
apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
apply (intro exI) apply simp
apply (subgoal_tac "ram2 # ys @ y # ram1 # vs = (ram2 # ys) @ y # ram1 # vs")
apply assumption
apply simp
apply simp
apply (case_tac "(c, d) ∈ Edges vs") apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ [c, d]
= (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # []") apply assumption apply simp
apply (rule impI) apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ ram1 # as @ c # d # bs
= (ram2 # between (vertices f) ram2 ram1 @ ram1 # as) @ c # d # bs") apply assumption apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # as @ c # d # bs @ ram1 # vs = (ram2 # as) @ c # d # (bs @ ram1 # vs)")
apply assumption by simp
qed
lemma split_face_edges_f21_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
"(f12, f21) = split_face f ram1 ram2 []"
"vs2 = between (vertices f) ram2 ram1" "vs2 ≠ []"
shows "edges f21 = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} ∪
Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
apply (case_tac " c = ram1 ∧ d = ram2") apply simp apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 = as")
apply (subgoal_tac "(ram2 # between (vertices f) ram2 ram1) @ [ram1] = as @ ram1 # d # bs")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ ram1 # d # bs")
apply simp apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (case_tac "c ∈ set (between (vertices f) ram2 ram1)")
apply (subgoal_tac "distinct (between (vertices f) ram2 ram1)") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac zs) apply simp apply (subgoal_tac "ram2 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp apply simp
apply (subgoal_tac "ram2 # ys = as") apply (simp add: Edges_def is_sublist_def)
apply (subgoal_tac "(ram2 # ys) @ c # a # list @ [ram1] = as @ c # d # bs")
apply (thin_tac "ram2 # ys @ c # a # list @ [ram1] = as @ c # d # bs")
apply (rule conjI) apply (rule impI) apply (rule disjI2)+ apply force
apply (rule impI) apply (rule disjI2)+ apply force apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (subgoal_tac "distinct (vertices f21)")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
apply (rule dist_f21)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "[] = as") apply simp apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (ram2 # between (vertices f) ram2 ram1 @ [ram1])")
apply (thin_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = ram2 ∧ d = hd (between (vertices f) ram2 ram1)") apply simp apply (rule disjI1)
apply (intro exI) apply (subgoal_tac "ram2 # between (vertices f) ram2 ram1 @ [ram1] =
[] @ ram2 # hd (between (vertices f) ram2 ram1) # tl (between (vertices f) ram2 ram1) @ [ram1]") apply assumption apply simp
apply (case_tac "c = ram1 ∧ d = ram2") apply (rule disjI2) apply simp apply simp
apply (case_tac "c = last (between (vertices f) ram2 ram1) ∧ d = ram1") apply (rule disjI1)
apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
apply (intro exI) apply simp
apply (subgoal_tac "ram2 # ys @ y # [ram1] = (ram2 # ys) @ y # [ram1]")
apply assumption apply simp apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # as @ c # d # bs @ [ram1] = (ram2 # as) @ c # d # (bs @ [ram1])")
apply assumption by simp
qed
lemma split_face_edges_f21_bet:
assumes vors: "pre_split_face f ram1 ram2 vs"
"(f12, f21) = split_face f ram1 ram2 vs"
"vs ≠ []" "between (vertices f) ram2 ram1 = []"
shows "edges f21 = {(ram1, hd vs), (last vs, ram2), (ram2, ram1)} ∪
Edges vs" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
apply (case_tac " c = last vs ∧ d = ram2") apply simp
apply simp apply (elim exE)
apply (case_tac "c = ram1") apply simp
apply (subgoal_tac "[ram2] = as") apply clarsimp
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (case_tac "c ∈ set vs")
apply (subgoal_tac "distinct vs") apply (simp add: in_set_conv_decomp) apply (elim exE) apply simp
apply (case_tac "zs") apply simp
apply (subgoal_tac "ram2 # ram1 # ys = as") apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply simp
apply (subgoal_tac "ram2 # ram1 # ys = as")
apply (subgoal_tac "(ram2 # ram1 # ys) @ c # a # list = as @ c # d # bs")
apply (thin_tac "ram2 # ram1 # ys @ c # a # list = as @ c # d # bs")
apply (simp add: Edges_def is_sublist_def) apply force
apply force
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (simp add: pre_split_face_def)
apply (subgoal_tac "c = ram2") apply simp
apply (subgoal_tac "[] = as") apply simp
apply (rule dist_at1) apply (rule dist_f21) apply (rule sym) apply simp apply simp
apply (subgoal_tac "c ∈ set (ram2 # ram1 # vs)")
apply (thin_tac "ram2 # ram1 # vs = as @ c # d # bs") apply simp
by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
apply (case_tac "c = ram2 ∧ d = ram1") apply simp apply (rule disjI1) apply force
apply (case_tac "c = ram1 ∧ d = hd vs") apply (rule disjI1)
apply (case_tac "vs") apply simp
apply simp apply (intro exI)
apply (subgoal_tac "ram2 # ram1 # a # list =
[ram2] @ ram1 # a # list") apply assumption apply simp
apply (case_tac "c = last vs ∧ d = ram2")
apply (case_tac vs rule: rev_exhaust) apply simp
apply simp
apply (simp add: Edges_def is_sublist_def)
apply (elim exE) apply simp apply (rule conjI) apply (rule impI) apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # ram1 # as @ [c, d]
= (ram2 # ram1 # as) @ c # d # []") apply assumption apply simp
apply (rule impI) apply (rule disjI1) apply (intro exI)
apply (subgoal_tac "ram2 # ram1 # as @ c # d # bs
= (ram2 # ram1 # as) @ c # d # bs") apply assumption by simp
qed
lemma split_face_edges_f21_bet_vs:
assumes vors: "pre_split_face f ram1 ram2 []"
"(f12, f21) = split_face f ram1 ram2 []"
"between (vertices f) ram2 ram1 = []"
shows "edges f21 = {(ram1, ram2), (ram2, ram1)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?rhs"
apply (simp add: split_face_def is_nextElem_def is_sublist_def dist_f21)
apply (case_tac " c = ram1 ∧ d = ram2") apply simp apply simp apply (elim exE)
apply (case_tac "as") apply simp apply (case_tac "list") by auto
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f21: "distinct (vertices f21)" apply (rule_tac split_face_distinct2) by auto
from x vors show "x ∈ ?lhs"
apply (simp add: dist_f21 is_nextElem_def is_sublist_def) apply (simp add: split_face_def)
by auto
qed
lemma split_face_edges_f21_subset: "pre_split_face f ram1 ram2 vs ⟹
(f12, f21) = split_face f ram1 ram2 vs ⟹ vs ≠ [] ⟹
{(last vs, ram2), (ram1, hd vs)} ∪ Edges vs ⊆ edges f21"
apply (case_tac "between (vertices f) ram2 ram1")
apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f21) apply simp+ by force
lemma verticesFrom_ram1: "pre_split_face f ram1 ram2 vs ⟹
verticesFrom f ram1 = ram1 # between (vertices f) ram1 ram2 @ ram2 # between (vertices f) ram2 ram1"
apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
apply (subgoal_tac "distinct (vertices f)")
apply (case_tac "before (vertices f) ram1 ram2")
apply (simp add: verticesFrom_Def)
apply (subgoal_tac "ram2 ∈ set (snd (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
apply (subgoal_tac "snd (splitAt ram2 (snd (splitAt ram1 (vertices f)))) = snd (splitAt ram2 (vertices f))")
apply simp apply (thin_tac "snd (splitAt ram1 (vertices f)) =
fst (splitAt ram2 (snd (splitAt ram1 (vertices f)))) @
ram2 # snd (splitAt ram2 (snd (splitAt ram1 (vertices f))))") apply simp
apply (rule before_dist_r2) apply simp apply simp
apply (subgoal_tac "before (vertices f) ram2 ram1")
apply (subgoal_tac "pre_between (vertices f) ram2 ram1")
apply (simp add: verticesFrom_Def)
apply (subgoal_tac "ram2 ∈ set (fst (splitAt ram1 (vertices f)))") apply (drule splitAt_ram)
apply (subgoal_tac "fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) = fst (splitAt ram2 (vertices f))")
apply simp apply (thin_tac "fst (splitAt ram1 (vertices f)) =
fst (splitAt ram2 (fst (splitAt ram1 (vertices f)))) @
ram2 # snd (splitAt ram2 (fst (splitAt ram1 (vertices f))))") apply simp
apply (rule before_dist_r1) apply simp apply simp apply (simp add: pre_between_def) apply force
apply (simp add: pre_split_face_def) by (rule pre_split_face_p_between)
lemma split_face_edges_f_vs1_vs2:
assumes vors: "pre_split_face f ram1 ram2 vs"
"between (vertices f) ram1 ram2 = []"
"between (vertices f) ram2 ram1 = []"
shows "edges f = {(ram2, ram1) , (ram1, ram2)}" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from x vors show "x ∈ ?rhs" apply (simp add: dist_f)
apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
apply (drule is_nextElem_or) apply assumption
apply (simp add: Edges_def)
apply (case_tac "is_sublist [c, d] [ram1, ram2]") apply (simp)
apply (simp) apply blast
by (rule pre_split_face_p_between)
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from x vors show "x ∈ ?lhs" apply (simp add: dist_f)
apply (subgoal_tac "ram1 ∈ 𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
apply (simp add: is_nextElem_def) apply blast
by (simp add: pre_split_face_def)
qed
lemma split_face_edges_f_vs1:
assumes vors: "pre_split_face f ram1 ram2 vs"
"between (vertices f) ram1 ram2 = []"
"vs2 = between (vertices f) ram2 ram1" "vs2 ≠ []"
shows "edges f = {(last vs2, ram1) , (ram1, ram2), (ram2, hd vs2)} ∪
Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?rhs" apply (simp add: dist_f)
apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
apply (drule is_nextElem_or) apply assumption
apply (simp add: Edges_def)
apply (case_tac "is_sublist [c, d] [ram1, ram2]")
apply simp
apply simp
apply(erule disjE) apply blast
apply (case_tac "c = ram2")
apply (case_tac "between (vertices f) ram2 ram1") apply simp
apply simp
apply (drule is_sublist_distinct_prefix)
apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
apply simp
apply (rule dist_vs2)
apply simp
apply (case_tac "c = ram1")
apply (subgoal_tac "¬ is_sublist [c, d] (ram2 # vs2 @ [ram1])")
apply simp
apply (rule is_sublist_notlast)
apply (rule_tac dist_vs2)
apply simp
apply simp
apply (simp add: is_sublist_def)
apply (elim exE)
apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp
apply simp
apply (case_tac "bs" rule: rev_exhaust) apply simp
apply simp
apply (rule disjI2)
apply (intro exI)
apply simp
apply (rule pre_split_face_p_between) by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f)
apply (subgoal_tac "ram1 ∈ set (vertices f)") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
apply (simp add: is_nextElem_def)
apply (case_tac "c = last (between (vertices f) ram2 ram1) ∧ d = ram1") apply simp apply simp apply (rule disjI1)
apply (case_tac "c = ram1 ∧ d = ram2") apply (simp add: is_sublist_def) apply force apply simp
apply (case_tac "c = ram2 ∧ d = hd (between (vertices f) ram2 ram1)")
apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
apply (subgoal_tac "ram1 # ram2 # a # list =
[ram1] @ ram2 # a # (list)") apply assumption apply simp
apply simp
apply (subgoal_tac "is_sublist [c, d] ((ram1 #
[ram2]) @ between (vertices f) ram2 ram1 @ [])")
apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
by (simp add: pre_split_face_def)
qed
lemma split_face_edges_f_vs2:
assumes vors: "pre_split_face f ram1 ram2 vs"
"vs1 = between (vertices f) ram1 ram2" "vs1 ≠ []"
"between (vertices f) ram2 ram1 = []"
shows "edges f = {(ram2, ram1) , (ram1, hd vs1), (last vs1, ram2)} ∪
Edges vs1" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?rhs" apply (simp add: dist_f)
apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
apply (drule is_nextElem_or) apply assumption
apply (simp add: Edges_def)
apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])")
apply simp
apply (case_tac "c = ram1")
apply (case_tac "between (vertices f) ram1 ram2") apply simp
apply simp
apply (drule is_sublist_distinct_prefix)
apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])") apply simp
apply (rule dist_vs1)
apply simp
apply (case_tac "c = ram2")
apply (subgoal_tac "¬ is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
apply (rule is_sublist_notlast) apply (rule_tac dist_vs1)
apply simp
apply simp
apply (simp add: is_sublist_def)
apply (elim exE)
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp
apply simp
apply (case_tac "bs" rule: rev_exhaust) apply simp
apply simp
apply (rule disjI2)
apply (intro exI)
apply simp
apply simp
apply (rule pre_split_face_p_between) by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f)
apply (subgoal_tac "ram1 ∈ 𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
apply (simp add: is_nextElem_def)
apply (case_tac "c = ram2 ∧ d = ram1") apply simp apply simp apply (rule disjI1)
apply (case_tac "c = ram1 ∧ d = hd (between (vertices f) ram1 ram2)")
apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
apply (case_tac "c = last (between (vertices f) ram1 ram2) ∧ d = ram2")
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
apply (intro exI)
apply (subgoal_tac "ram1 # ys @ [y, ram2] =
(ram1 # ys) @ y # ram2 # []") apply assumption apply simp
apply simp
apply (simp add: Edges_def)
apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @ [ram2])")
apply simp apply (rule is_sublist_add) apply simp
by (simp add: pre_split_face_def)
qed
lemma split_face_edges_f:
assumes vors: "pre_split_face f ram1 ram2 vs"
"vs1 = between (vertices f) ram1 ram2" "vs1 ≠ []"
"vs2 = between (vertices f) ram2 ram1" "vs2 ≠ []"
shows "edges f = {(last vs2, ram1) , (ram1, hd vs1), (last vs1, ram2), (ram2, hd vs2)} ∪
Edges vs1 ∪ Edges vs2" (is "?lhs = ?rhs")
proof (intro equalityI subsetI)
fix x
assume x: "x ∈ ?lhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?rhs" apply (simp add: dist_f)
apply (subgoal_tac "pre_between (vertices f) ram1 ram2")
apply (drule is_nextElem_or) apply assumption apply (simp add: Edges_def)
apply (case_tac "is_sublist [c, d] (ram1 # between (vertices f) ram1 ram2 @ [ram2])") apply simp
apply (case_tac "c = ram1")
apply (case_tac "between (vertices f) ram1 ram2") apply simp apply simp
apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram1 # vs1 @ [ram2])")
apply simp apply (rule dist_vs1) apply simp
apply (case_tac "c = ram2")
apply (subgoal_tac "¬ is_sublist [c, d] (ram1 # vs1 @ [ram2])") apply simp
apply (rule is_sublist_notlast) apply (rule_tac dist_vs1) apply simp
apply simp apply (simp add: is_sublist_def) apply (elim exE)
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply simp
apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
apply (rule disjI2) apply (rule disjI2) apply (rule disjI1) apply (intro exI) apply simp
apply simp
apply (case_tac "c = ram2")
apply (case_tac "between (vertices f) ram2 ram1") apply simp apply simp
apply (drule is_sublist_distinct_prefix) apply (subgoal_tac "distinct (ram2 # vs2 @ [ram1])")
apply simp apply (rule dist_vs2) apply simp
apply (case_tac "c = ram1")
apply (subgoal_tac "¬ is_sublist [c, d] (ram2 # vs2 @ [ram1])") apply simp
apply (rule is_sublist_notlast) apply (rule_tac dist_vs2) apply simp
apply simp apply (simp add: is_sublist_def) apply (elim exE)
apply (case_tac "between (vertices f) ram2 ram1" rule: rev_exhaust) apply simp apply simp
apply (case_tac "bs" rule: rev_exhaust) apply simp apply simp
apply (rule disjI2) apply (rule disjI2) apply (rule disjI2) apply (intro exI) apply simp
apply (rule pre_split_face_p_between) by simp
next
fix x
assume x: "x ∈ ?rhs"
define c where "c = fst x"
define d where "d = snd x"
with c_def have [simp]: "x = (c,d)" by simp
from vors have dist_f: "distinct (vertices f)" by (simp add: pre_split_face_def)
from vors have dist_vs1: "distinct (ram1 # vs1 @ [ram2])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) by (simp add: pre_split_face_def)
from vors have dist_vs2: "distinct (ram2 # vs2 @ [ram1])" apply (simp only:)
apply (rule between_distinct_r12) apply (rule dist_f) apply (rule not_sym) by (simp add: pre_split_face_def)
from x vors show "x ∈ ?lhs"
supply [[simproc del: defined_all]]
apply (simp add: dist_f)
apply (subgoal_tac "ram1 ∈ 𝒱 f") apply (simp add: verticesFrom_is_nextElem verticesFrom_ram1)
apply (simp add: is_nextElem_def)
apply (case_tac "c = last (between (vertices f) ram2 ram1) ∧ d = ram1") apply simp apply simp apply (rule disjI1)
apply (case_tac "c = ram1 ∧ d = hd (between (vertices f) ram1 ram2)")
apply (case_tac "between (vertices f) ram1 ram2") apply simp apply (force simp: is_sublist_def) apply simp
apply (case_tac "c = last (between (vertices f) ram1 ram2) ∧ d = ram2")
apply (case_tac "between (vertices f) ram1 ram2" rule: rev_exhaust) apply simp apply (simp add: is_sublist_def)
apply (intro exI)
apply (subgoal_tac "ram1 # ys @ y # ram2 # between (vertices f) ram2 ram1 =
(ram1 # ys) @ y # ram2 # (between (vertices f) ram2 ram1)") apply assumption apply simp apply simp
apply (case_tac "c = ram2 ∧ d = hd (between (vertices f) ram2 ram1)")
apply (case_tac "between (vertices f) ram2 ram1") apply simp apply (simp add: is_sublist_def) apply (intro exI)
apply (subgoal_tac "ram1 # between (vertices f) ram1 ram2 @ ram2 # a # list =
(ram1 # between (vertices f) ram1 ram2) @ ram2 # a # (list)") apply assumption apply simp apply simp
apply (case_tac "(c, d) ∈ Edges (between (vertices f) ram1 ram2)") apply (simp add: Edges_def)
apply (subgoal_tac "is_sublist [c, d] ([ram1] @ between (vertices f) ram1 ram2 @
(ram2 # between (vertices f) ram2 ram1))")
apply simp apply (rule is_sublist_add) apply simp
apply simp
apply (subgoal_tac "is_sublist [c, d] ((ram1 # between (vertices f) ram1 ram2 @
[ram2]) @ between (vertices f) ram2 ram1 @ [])")
apply simp apply (rule is_sublist_add) apply (simp add: Edges_def)
by (simp add: pre_split_face_def)
qed
lemma split_face_edges_f12_f21:
"pre_split_face f ram1 ram2 vs ⟹ (f12, f21) = split_face f ram1 ram2 vs ⟹
vs ≠ []
⟹ edges f12 ∪ edges f21 = edges f ∪
{(hd vs, ram1), (ram1, hd vs), (last vs, ram2), (ram2, last vs)} ∪
Edges vs ∪
Edges (rev vs)"
apply (case_tac "between (vertices f) ram1 ram2 = []")
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (simp add: split_face_edges_f12_bet split_face_edges_f21_bet split_face_edges_f_vs1_vs2)
apply force
apply (simp add: split_face_edges_f12_bet split_face_edges_f21 split_face_edges_f_vs1) apply force
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (simp add: split_face_edges_f21_bet split_face_edges_f12 split_face_edges_f_vs2) apply force
apply (simp add: split_face_edges_f21 split_face_edges_f12 split_face_edges_f) by force
lemma split_face_edges_f12_f21_vs:
"pre_split_face f ram1 ram2 [] ⟹ (f12, f21) = split_face f ram1 ram2 []
⟹ edges f12 ∪ edges f21 = edges f ∪
{(ram2, ram1), (ram1, ram2)}"
apply (case_tac "between (vertices f) ram1 ram2 = []")
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_bet_vs split_face_edges_f_vs1_vs2)
apply force
apply (simp add: split_face_edges_f12_bet_vs split_face_edges_f21_vs split_face_edges_f_vs1) apply force
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (simp add: split_face_edges_f21_bet_vs split_face_edges_f12_vs split_face_edges_f_vs2) apply force
apply (simp add: split_face_edges_f21_vs split_face_edges_f12_vs split_face_edges_f) by force
lemma split_face_edges_f12_f21_sym:
"f ∈ ℱ g ⟹
pre_split_face f ram1 ram2 vs ⟹ (f12, f21) = split_face f ram1 ram2 vs
⟹ ((a,b) ∈ edges f12 ∨ (a,b) ∈ edges f21) =
((a,b) ∈ edges f ∨
(((b,a) ∈ edges f12 ∨ (b,a) ∈ edges f21) ∧
((a,b) ∈ edges f12 ∨ (a,b) ∈ edges f21)))"
apply (subgoal_tac "((a,b) ∈ edges f12 ∪ edges f21) =
((a,b) ∈ edges f ∨ ((b,a) ∈ edges f12 ∪ edges f21) ∧ (a,b) ∈ edges f12 ∪ edges f21)") apply force
apply (case_tac "vs = []")
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (drule split_face_edges_f12_f21_vs) apply simp apply simp apply force apply simp
apply (drule split_face_edges_f12_f21) apply simp apply simp
apply simp by force
lemma splitFace_edges_g'_help: "pre_splitFace g ram1 ram2 f vs ⟹
(f12, f21, g') = splitFace g ram1 ram2 f vs ⟹ vs ≠ [] ⟹
edges g' = edges g ∪ edges f ∪ Edges vs ∪ Edges(rev vs) ∪
{(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
proof -
assume pre: "pre_splitFace g ram1 ram2 f vs"
and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f vs"
and vs_neq: "vs ≠ []"
from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 vs"
apply (unfold pre_splitFace_def) apply (elim conjE)
by (simp add: splitFace_split_face)
from fdg pre have "edges g' = (⋃⇘a∈set (replace f [f21] (faces g))⇙ edges a) ∪
edges (f12)" by(auto simp: splitFace_def split_def edges_graph_def)
with pre vs_neq show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
apply (case_tac "xa ∈ ℱ g") apply simp
apply (subgoal_tac "x ∈ edges g") apply simp
apply (simp add: edges_graph_def) apply force
apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (frule split_face_edges_f21_bet) apply (rule split) apply simp apply simp
apply (case_tac "between (vertices f) ram1 ram2 = []")
apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f21) apply (rule split) apply simp apply simp apply simp
apply (case_tac "between (vertices f) ram1 ram2 = []")
apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply simp apply force
apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
apply (case_tac "between (vertices f) ram1 ram2 = []")
apply (frule split_face_edges_f12_bet) apply (rule split) apply simp apply simp
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (frule split_face_edges_f_vs1_vs2) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f_vs1) apply simp apply simp apply simp apply force
apply (frule split_face_edges_f12) apply (rule split) apply simp apply simp apply simp
apply (case_tac "between (vertices f) ram2 ram1 = []")
apply (frule split_face_edges_f_vs2) apply simp apply simp apply simp apply simp apply force
apply (frule split_face_edges_f) apply simp apply simp apply simp apply simp apply force
apply simp
apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 vs")
apply (subgoal_tac "(ram2, last vs) ∈ edges f12 ∧ (hd vs, ram1) ∈ edges f12")
apply (rule conjI) apply simp
apply (rule conjI) apply simp
apply (subgoal_tac "(ram1, hd vs) ∈ edges f21 ∧ (last vs, ram2) ∈ edges f21")
apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply (elim conjE) apply simp
apply (rule replace3) apply(erule pre_splitFace_oldF)
apply simp
apply (subgoal_tac "edges f ⊆ {y. ∃x∈set (replace f [f21] (faces g)). y ∈ edges x} ∪ edges f12")
apply (subgoal_tac "edges g ⊆ {y. ∃x∈set (replace f [f21] (faces g)). y ∈ edges x} ∪ edges f12")
apply (rule conjI) apply simp
apply (rule conjI) apply simp
apply (subgoal_tac "Edges(rev vs) ⊆ edges f12") apply (rule conjI) prefer 2 apply blast
apply (subgoal_tac "Edges vs ⊆ edges f21")
apply (subgoal_tac "Edges vs ⊆ {y. ∃x∈set (replace f [f21] (faces g)). y ∈ edges x}") apply blast
apply (rule subset_trans) apply assumption apply (rule subsetI) apply simp apply (rule bexI) apply simp
apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp
apply (frule split_face_edges_f21_subset) apply (rule split) apply simp apply simp
apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
apply (simp add: edges_graph_def) apply (rule subsetI) apply simp apply (elim bexE)
apply (case_tac "xa = f") apply simp apply blast
apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
apply (rule subsetI)
apply (subgoal_tac "∃ u v. x = (u,v)") apply (elim exE conjE)
apply (frule split_face_edges_or [OF split]) apply simp
apply (case_tac "(u, v) ∈ edges f12") apply simp apply simp
apply (rule bexI) apply (thin_tac "(u, v) ∈ edges f") apply assumption
apply (rule replace3) apply(erule pre_splitFace_oldF) apply simp apply simp
apply (frule split_face_edges_f21_subset) apply (rule split) apply simp apply simp
apply (frule split_face_edges_f12_subset) apply (rule split) apply simp apply simp
by simp
qed
lemma pre_splitFace_edges_f_in_g: "pre_splitFace g ram1 ram2 f vs ⟹ edges f ⊆ edges g"
apply (simp add: edges_graph_def) by (force)
lemma pre_splitFace_edges_f_in_g2: "pre_splitFace g ram1 ram2 f vs ⟹ x ∈ edges f ⟹ x ∈ edges g"
apply (simp add: edges_graph_def) by (force)
lemma splitFace_edges_g': "pre_splitFace g ram1 ram2 f vs ⟹
(f12, f21, g') = splitFace g ram1 ram2 f vs ⟹ vs ≠ [] ⟹
edges g' = edges g ∪ Edges vs ∪ Edges(rev vs) ∪
{(ram2, last vs), (hd vs, ram1), (ram1, hd vs), (last vs, ram2)}"
apply (subgoal_tac "edges g ∪ edges f = edges g")
apply (frule splitFace_edges_g'_help) apply simp apply simp apply simp
apply (frule pre_splitFace_edges_f_in_g) by blast
lemma splitFace_edges_g'_vs: "pre_splitFace g ram1 ram2 f [] ⟹
(f12, f21, g') = splitFace g ram1 ram2 f [] ⟹
edges g' = edges g ∪ {(ram1, ram2), (ram2, ram1)}"
proof -
assume pre: "pre_splitFace g ram1 ram2 f []"
and fdg: "(f12, f21, g') = splitFace g ram1 ram2 f []"
from pre fdg have split: "(f12, f21) = split_face f ram1 ram2 []"
apply (unfold pre_splitFace_def) apply (elim conjE)
by (simp add: splitFace_split_face)
from fdg pre have "edges g' = (⋃⇘a∈set (replace f [f21] (faces g))⇙ edges a) ∪
edges (f12)" by (auto simp: splitFace_def split_def edges_graph_def)
with pre show ?thesis apply (simp add: UNION_eq) apply (rule equalityI) apply simp
apply (rule conjI) apply (rule subsetI) apply simp apply (erule bexE) apply (drule replace5)
apply (case_tac "xa ∈ ℱ g") apply simp
apply (subgoal_tac "x ∈ edges g") apply simp
apply (simp add: edges_graph_def) apply force
apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (case_tac "between (vertices f) ram2 ram1 = []") apply (simp add: pre_FaceDiv_between2)
apply (frule split_face_edges_f21_vs) apply (rule split) apply simp apply simp apply simp
apply (case_tac "x = (ram1, ram2)") apply simp apply simp apply (rule disjI2)
apply (rule pre_splitFace_edges_f_in_g2) apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (frule split_face_edges_f) apply simp apply simp apply (rule pre_FaceDiv_between1) apply simp apply simp
apply simp apply force apply simp apply simp
apply (rule subsetI) apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (case_tac "between (vertices f) ram1 ram2 = []") apply (simp add: pre_FaceDiv_between1)
apply (frule split_face_edges_f12_vs) apply (rule split) apply simp apply simp apply simp
apply (case_tac "x = (ram2, ram1)") apply simp apply simp apply (rule disjI2)
apply (rule pre_splitFace_edges_f_in_g2) apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (frule split_face_edges_f) apply simp apply simp apply simp apply (rule pre_FaceDiv_between2) apply simp
apply simp apply force apply simp apply simp
apply simp
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (subgoal_tac "(ram1, ram2) ∈ edges f21")
apply (rule conjI) apply (rule disjI1) apply (rule bexI) apply simp apply (force)
apply (subgoal_tac "(ram2, ram1) ∈ edges f12")
apply (rule conjI) apply force
apply (rule subsetI) apply (simp add: edges_graph_def) apply (elim bexE)
apply (case_tac "xa = f") apply simp
apply (subgoal_tac "∃ u v. x = (u,v)") apply (elim exE conjE)
apply (subgoal_tac "pre_split_face f ram1 ram2 []")
apply (frule split_face_edges_or [OF split]) apply simp
apply (case_tac "(u, v) ∈ edges f12") apply simp apply simp apply force apply simp apply simp
apply (rule disjI1) apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
apply (frule split_face_edges_f12_vs) apply simp apply (rule split) apply simp
apply (rule pre_FaceDiv_between1) apply simp apply simp
apply (frule split_face_edges_f21_vs) apply simp apply (rule split) apply simp
apply (rule pre_FaceDiv_between2) apply simp apply simp
by simp
qed
lemma splitFace_edges_incr:
"pre_splitFace g ram1 ram2 f vs ⟹
(f⇩1, f⇩2, g') = splitFace g ram1 ram2 f vs ⟹
edges g ⊆ edges g'"
apply(cases vs)
apply(simp add:splitFace_edges_g'_vs)
apply blast
apply(simp add:splitFace_edges_g')
apply blast
done
lemma snd_snd_splitFace_edges_incr:
"pre_splitFace g v⇩1 v⇩2 f vs ⟹
edges g ⊆ edges(snd(snd(splitFace g v⇩1 v⇩2 f vs)))"
apply(erule splitFace_edges_incr
[where f⇩1 = "fst(splitFace g v⇩1 v⇩2 f vs)"
and f⇩2 = "fst(snd(splitFace g v⇩1 v⇩2 f vs))"])
apply(auto)
done
subsection ‹‹removeNones››
definition removeNones :: "'a option list ⇒ 'a list" where
"removeNones vOptionList ≡ [the x. x ← vOptionList, x ≠ None]"
declare removeNones_def [simp]
lemma removeNones_inI[intro]: "Some a ∈ set ls ⟹ a ∈ set (removeNones ls)" by (induct ls) auto
lemma removeNones_hd[simp]: "removeNones ( Some a # ls) = a # removeNones ls" by auto
lemma removeNones_last[simp]: "removeNones (ls @ [Some a]) = removeNones ls @ [a]" by auto
lemma removeNones_in[simp]: "removeNones (as @ Some a # bs) = removeNones as @ a # removeNones bs" by auto
lemma removeNones_none_hd[simp]: "removeNones ( None # ls) = removeNones ls" by auto
lemma removeNones_none_last[simp]: "removeNones (ls @ [None]) = removeNones ls" by auto
lemma removeNones_none_in[simp]: "removeNones (as @ None # bs) = removeNones (as @ bs)" by auto
lemma removeNones_empty[simp]: "removeNones [] = []" by auto
declare removeNones_def [simp del]
subsection‹‹natToVertexList››
primrec natToVertexListRec ::
"nat ⇒ vertex ⇒ face ⇒ nat list ⇒ vertex option list"
where
"natToVertexListRec old v f [] = []" |
"natToVertexListRec old v f (i#is) =
(if i = old then None#natToVertexListRec i v f is
else Some (f⇗i⇖ ∙ v)
# natToVertexListRec i v f is)"
primrec natToVertexList ::
"vertex ⇒ face ⇒ nat list ⇒ vertex option list"
where
"natToVertexList v f [] = []" |
"natToVertexList v f (i#is) =
(if i = 0 then (Some v)#(natToVertexListRec i v f is) else [])"
subsection ‹@{const indexToVertexList}›
lemma nextVertex_inj:
"distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹
i < length (vertices (f::face)) ⟹ a < length (vertices f) ⟹
f⇗a⇖∙v = f⇗i⇖∙v ⟹ i = a"
proof -
assume d: "distinct (vertices f)" and v: "v ∈ 𝒱 f" and i: "i < length (vertices (f::face))"
and a: "a < length (vertices f)" and eq:" f⇗a⇖∙v = f⇗i⇖∙v"
then have eq: "(verticesFrom f v)!a = (verticesFrom f v)!i " by (simp add: verticesFrom_nth)
define xs where "xs = verticesFrom f v"
with eq have eq: "xs!a = xs!i" by auto
from d v have z: "distinct (verticesFrom f v)" by auto
moreover
from xs_def a v d have "(verticesFrom f v) = take a xs @ xs ! a # drop (Suc a) xs"
by (auto intro: id_take_nth_drop simp: verticesFrom_length)
with eq have "(verticesFrom f v) = take a xs @ xs ! i # drop (Suc a) xs" by simp
moreover
from xs_def i v d have "(verticesFrom f v) = take i xs @ xs ! i # drop (Suc i) xs"
by (auto intro: id_take_nth_drop simp: verticesFrom_length)
ultimately have "take a xs = take i xs" by (rule dist_at1)
moreover
from v d have vertFrom[simp]: "length (vertices f) = length (verticesFrom f v)"
by (auto simp: verticesFrom_length)
from xs_def a i have "a < length xs" "i < length xs" by auto
moreover
have "⋀ a i. a < length xs ⟹ i < length xs ⟹ take a xs = take i xs ⟹ a = i"
proof (induct xs)
case Nil then show ?case by auto
next
case (Cons x xs) then show ?case
apply (cases a) apply auto
apply (cases i) apply auto
apply (cases i) by auto
qed
ultimately show ?thesis by simp
qed
lemma a: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ (∀i ∈ set is. i < length (vertices f)) ⟹
(⋀a. a < length (vertices f) ⟹ hideDupsRec ((f ∙ ^^ a) v) [(f ∙ ^^ k) v. k ← is] = natToVertexListRec a v f is)"
proof (induct "is")
case Nil then show ?case by simp
next
case (Cons i "is") then show ?case
by (auto simp: nextVertices_def intro: nextVertex_inj)
qed
lemma indexToVertexList_natToVertexList_eq: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹
(∀i ∈ set is. i < length (vertices f)) ⟹ is ≠ [] ⟹
hd is = 0 ⟹ indexToVertexList f v is = natToVertexList v f is"
apply (cases "is") by (auto simp: a [where a = 0, simplified] indexToVertexList_def nextVertices_def)
lemma nvlr_length: "⋀ old. (length (natToVertexListRec old v f ls)) = length ls"
apply (induct ls) by auto
lemma nvl_length[simp]: "hd e = 0 ⟹ length (natToVertexList v f e) = length e"
apply (cases "e")
by (auto intro: nvlr_length)
lemma natToVertexListRec_length[simp]: "⋀ e f. length (natToVertexListRec e v f es) = length es"
by (induct es) auto
lemma natToVertexList_length[simp]: "incrIndexList es (length es) (length (vertices f)) ⟹
length (natToVertexList v f es) = length es" apply (case_tac es) by simp_all
lemma natToVertexList_nth_Suc: "incrIndexList es (length es) (length (vertices f)) ⟹ Suc n < length es ⟹
(natToVertexList v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f⇗(es!Suc n)⇖ ∙ v))"
proof -
assume incr: "incrIndexList es (length es) (length (vertices f))" and n: "Suc n < length es"
have rec: "⋀ old n. Suc n < length es ⟹
(natToVertexListRec old v f es)!(Suc n) = (if (es!n = es!(Suc n)) then None else Some (f⇗(es!Suc n)⇖ ∙ v))"
proof (induct es)
case Nil then show ?case by auto
next
case (Cons e es)
note cons1 = this
then show ?case
proof (cases es)
case Nil with cons1 show ?thesis by simp
next
case (Cons e' es')
with cons1 show ?thesis
proof (cases n)
case 0 with Cons cons1 show ?thesis by simp
next
case (Suc m) with Cons cons1
have "⋀ old. natToVertexListRec old v f es ! Suc m = (if es ! m = es ! Suc m then None else Some (f⇗es ! Suc m⇖ ∙ v))"
by (rule_tac cons1) auto
then show ?thesis apply (cases "e = old") by (simp_all add: Suc)
qed
qed
qed
with n have "natToVertexListRec 0 v f es ! Suc n = (if es ! n = es ! Suc n then None else Some (f⇗es ! Suc n⇖ ∙ v))" by (rule_tac rec) auto
with incr show ?thesis by (cases es) auto
qed
lemma natToVertexList_nth_0: "incrIndexList es (length es) (length (vertices f)) ⟹ 0 < length es ⟹
(natToVertexList v f es)!0 = Some (f⇗(es!0)⇖ ∙ v)"
apply (cases es)
apply (simp_all add: nextVertices_def)
by (subgoal_tac "a = 0") auto
lemma natToVertexList_hd[simp]:
"incrIndexList es (length es) (length (vertices f)) ⟹ hd (natToVertexList v f es) = Some v"
apply (cases es) by (simp_all add: nextVertices_def)
lemma nth_last[intro]: "Suc i = length xs ⟹ xs!i = last xs"
by (cases xs rule: rev_exhaust) auto
declare incrIndexList_help4 [simp del]
lemma natToVertexList_last[simp]:
"distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ incrIndexList es (length es) (length (vertices f)) ⟹ last (natToVertexList v f es) = Some (last (verticesFrom f v))"
proof -
assume vors: "distinct (vertices f)" "v ∈ 𝒱 f" and incr: "incrIndexList es (length es) (length (vertices f))"
define n' where "n' = length es - 2"
from incr have "1 < length es" by auto
with n'_def have n'l: "Suc (Suc n') = length es" by arith
from incr n'l have last_ntvl: "(natToVertexList v f es)!(Suc n') = last (natToVertexList v f es)" by auto
from n'l have last_es: "es!(Suc n') = last es" by auto
from n'l have "es!n' = last (butlast es)" apply (cases es rule: rev_exhaust) by (auto simp: nth_append)
with last_es incr have less: "es!n' < es!(Suc n')" by auto
from n'l have "Suc n' < length es" by arith
with incr less have "(natToVertexList v f es)!(Suc n') = (Some (f⇗(es!Suc n')⇖ ∙ v))" by (auto dest: natToVertexList_nth_Suc)
with incr last_ntvl last_es have rule1: "last (natToVertexList v f es) = Some (f⇗((length (vertices f)) - (Suc 0))⇖ ∙ v)" by auto
from incr have lvf: "1 < length (vertices f)" by auto
with vors have rule2: "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = f⇗((length (vertices f)) - (Suc 0))⇖ ∙ v" by (auto intro!: verticesFrom_nth)
from vors lvf have "verticesFrom f v ! ((length (vertices f)) - (Suc 0)) = last (verticesFrom f v)"
apply (rule_tac nth_last)
by (auto simp: verticesFrom_length)
with rule1 rule2 show ?thesis by auto
qed
lemma indexToVertexList_last[simp]:
"distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ incrIndexList es (length es) (length (vertices f)) ⟹ last (indexToVertexList f v es) = Some (last (verticesFrom f v))"
apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
apply (rule indexToVertexList_natToVertexList_eq) by auto
lemma nths_take: "⋀ n iset. ∀ i ∈ iset. i < n ⟹ nths (take n xs) iset = nths xs iset"
proof (induct xs)
case Nil then show ?case by simp
next
case (Cons x xs) then show ?case apply (simp add: nths_Cons) apply (cases n) apply simp apply (simp add: nths_Cons) apply (rule Cons) by auto
qed
lemma nths_reduceIndices: "⋀ iset. nths xs iset = nths xs {i. i < length xs ∧ i ∈ iset}"
proof (induct xs)
case Nil then show ?case by simp
next
case (Cons x xs) then
have "nths xs {j. Suc j ∈ iset} = nths xs {i. i < length xs ∧ i ∈ {j. Suc j ∈ iset}}" by (rule_tac Cons)
then show ?case by (simp add: nths_Cons)
qed
lemma natToVertexList_nths1: "distinct (vertices f) ⟹
v ∈ 𝒱 f ⟹ vs = verticesFrom f v ⟹
incrIndexList es (length es) (length vs) ⟹ n ≤ length es ⟹
nths (take (Suc (es!(n - 1))) vs) (set (take n es))
= removeNones (take n (natToVertexList v f es))"
proof (induct n)
case 0 then show ?case by simp
next
case (Suc n)
then have "nths (take (Suc (es ! (n - Suc 0))) (verticesFrom f v)) (set (take n es)) = removeNones (take n (natToVertexList v f es))"
"distinct (vertices f)" "v ∈ 𝒱 f" "vs = verticesFrom f v" "incrIndexList es (length es) (length (verticesFrom f v))" "Suc n ≤ length es" by auto
note suc1 = this
then have lvs: "length vs = length (vertices f)" by (auto intro: verticesFrom_length)
with suc1 have vsne: "vs ≠ []" by auto
with suc1 show ?case
proof (cases "natToVertexList v f es ! n")
case None then show ?thesis
proof (cases n)
case 0 with None suc1 lvs show ?thesis by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0)
next
case (Suc n')
with None suc1 lvs have esn: "es!n = es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
from Suc have n': "n - Suc 0 = n'" by auto
show ?thesis
proof (cases "Suc n = length es")
case True then
have small_n: "n < length es" by auto
from True have "take (Suc n) es = es" by auto
with small_n have "take n es @ [es!n] = es" by (simp add: take_Suc_conv_app_nth)
then have esn_simps: "take n es = butlast es ∧ es!n = last es" by (cases es rule: rev_exhaust) auto
from True Suc have n'l: "Suc n' = length (butlast es)" by auto
then have small_n': "n' < length (butlast es)" by auto
from Suc small_n have take_n': "take (Suc n') (butlast es @ [last es]) = take (Suc n') (butlast es)" by auto
from small_n have es_exh: "es = butlast es @ [last es]" by (cases es rule: rev_exhaust) auto
from n'l have "take (Suc n') (butlast es @ [last es]) = butlast es" by auto
with es_exh have "take (Suc n') es = butlast es" by auto
with small_n Suc have "take n' es @ [es!n'] = (butlast es)" by (simp add: take_Suc_conv_app_nth)
with small_n' have esn'_simps: "take n' es = butlast (butlast es) ∧ es!n' = last (butlast es)"
by (cases "butlast es" rule: rev_exhaust) auto
from suc1 have "last (butlast es) < last es" by auto
with esn esn_simps esn'_simps have False by auto
then show ?thesis by auto
next
case False with suc1 have le: "Suc n < length es" by auto
from suc1 le have "es = take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es" by (auto intro: id_take_nth_drop)
with suc1 have "increasing (take (Suc n) es @ es!(Suc n) # drop (Suc (Suc n)) es)" by auto
then have "∀ i ∈ (set (take (Suc n) es)). i ≤ es ! (Suc n)" by (auto intro: increasing2)
with suc1 have "∀ i ∈ (set (take n es)). i ≤ es ! (Suc n)" by (simp add: take_Suc_conv_app_nth)
then have seq: "nths (take (Suc (es ! Suc n)) (verticesFrom f v)) (set (take n es))
= nths (verticesFrom f v) (set (take n es))"
apply (rule_tac nths_take) by auto
from suc1 have "es = take n es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
with suc1 have "increasing (take n es @ es!n # drop (Suc n) es)" by auto
then have "∀ i ∈ (set (take n es)). i ≤ es ! n" by (auto intro: increasing2)
with suc1 esn have "∀ i ∈ (set (take n es)). i ≤ es ! n'" by (simp add: take_Suc_conv_app_nth)
with Suc have seq2: "nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es))
= nths (verticesFrom f v) (set (take n es))"
apply (rule_tac nths_take) by auto
from Suc suc1 have "(insert (es ! n') (set (take n es))) = set (take n es)"
apply auto by (simp add: take_Suc_conv_app_nth)
with esn None suc1 seq seq2 n' show ?thesis by (simp add: take_Suc_conv_app_nth)
qed
qed
next
case (Some v') then show ?thesis
proof (cases n)
case 0
from suc1 lvs have "verticesFrom f v ≠ []" by auto
then have "verticesFrom f v = hd (verticesFrom f v) # tl (verticesFrom f v)" by auto
then have "verticesFrom f v = v # tl (verticesFrom f v)" by (simp add: verticesFrom_hd)
then obtain z where "verticesFrom f v = v # z" by auto
then have sub: "nths (verticesFrom f v) {0} = [v]" by (auto simp: nths_Cons)
from 0 suc1 have "es!0 = 0" by (cases es) auto
with 0 Some suc1 lvs sub vsne show ?thesis
by (simp add: take_Suc_conv_app_nth natToVertexList_nth_0 nextVertices_def take_Suc
nths_Cons verticesFrom_hd del:verticesFrom_empty)
next
case (Suc n')
with Some suc1 lvs have esn: "es!n ≠ es!n'" by (simp add: natToVertexList_nth_Suc split: if_split_asm)
from suc1 Suc have "Suc n' < length es" by auto
with suc1 lvs esn have "natToVertexList v f es !(Suc n') = Some (f⇗(es!(Suc n'))⇖ ∙ v)"
apply (simp add: natToVertexList_nth_Suc)
by (simp add: Suc)
with Suc have "natToVertexList v f es ! n = Some (f⇗(es!n)⇖ ∙ v)" by auto
with Some have v': "v' = f⇗(es!n)⇖ ∙ v" by simp
from Suc have n': "n - Suc 0 = n'" by auto
from suc1 Suc have "es = take (Suc n') es @ es!n # drop (Suc n) es" by (auto intro: id_take_nth_drop)
with suc1 have "increasing (take (Suc n') es @ es!n # drop (Suc n) es)" by auto
with suc1 Suc have "es!n' ≤ es!n" apply (auto intro!: increasing2)
by (auto simp: take_Suc_conv_app_nth)
with esn have smaller_n: "es!n' < es!n" by auto
from suc1 lvs have smaller: "(es!n) < length vs" by auto
from suc1 smaller lvs have "(verticesFrom f v)!(es!n) = f⇗(es!n)⇖ ∙ v" by (auto intro: verticesFrom_nth)
with v' have "(verticesFrom f v)!(es!n) = v'" by auto
then have sub1: "nths ([((verticesFrom f v)!(es!n))])
{j. j + (es!n) : (insert (es ! n) (set (take n es)))} = [v']" by auto
from suc1 smaller lvs have len: "length (take (es ! n) (verticesFrom f v)) = es!n" by auto
have "⋀x. x ∈ (set (take n es)) ⟹ x < (es ! n)"
proof -
fix x
assume x: "x ∈ set (take n es)"
from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
then have "⋀ x. x ∈ set (take n' es) ⟹ x ≤ es!n'" by (auto intro!: increasing2)
with x Suc suc1 have "x ≤ es!n'" by (auto simp: take_Suc_conv_app_nth)
with smaller_n show "x < es!n" by auto
qed
then have "{i. i < es ! n ∧ i ∈ set (take n es)} = (set (take n es))" by auto
then have elim_insert: "{i. i < es ! n ∧ i ∈ insert (es ! n) (set (take n es))} = (set (take n es))" by auto
have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
nths (take (es ! n) (verticesFrom f v)) {i. i < length (take (es ! n) (verticesFrom f v))
∧ i ∈ (insert (es ! n) (set (take n es)))}" by (rule nths_reduceIndices)
with len have "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
nths (take (es ! n) (verticesFrom f v)) {i. i < (es ! n) ∧ i ∈ (insert (es ! n) (set (take n es)))}"
by simp
with elim_insert have sub2: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
nths (take (es ! n) (verticesFrom f v)) (set (take n es))" by simp
define m where "m = es!n - es!n'"
with smaller_n have mgz: "0 < m" by auto
with m_def have esn: "es!n = (es!n') + m" by auto
have helper: "⋀x. x ∈ (set (take n es)) ⟹ x ≤ (es ! n')"
proof -
fix x
assume x: "x ∈ set (take n es)"
from suc1 Suc have "es = take n' es @ es!n' # drop (Suc n') es" by (auto intro: id_take_nth_drop)
with suc1 have "increasing (take n' es @ es!n' # drop (Suc n') es)" by auto
then have "⋀ x. x ∈ set (take n' es) ⟹ x ≤ es!n'" by (auto intro!: increasing2)
with x Suc suc1 show "x ≤ es!n'" by (auto simp: take_Suc_conv_app_nth)
qed
define m' where "m' = m - 1"
define Suc_es_n' where "Suc_es_n' = Suc (es!n')"
from smaller smaller_n have "Suc (es!n') < length vs" by auto
then have "min (length vs) (Suc (es ! n')) = Suc (es!n')" by arith
with Suc_es_n'_def have empty: "{j. j + length (take Suc_es_n' vs) ∈ set (take n es)} = {}"
apply auto apply (frule helper) by arith
from Suc_es_n'_def mgz esn m'_def have esn': "es!n = Suc_es_n' + m'" by auto
with smaller have "(take (Suc_es_n' + m') vs) = take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)"
by (auto intro: take_add)
with esn' have "nths (take (es ! n) vs) (set (take n es))
= nths (take (Suc_es_n') vs @ take m' (drop (Suc_es_n') vs)) (set (take n es))" by auto
then have "nths (take (es ! n) vs) (set (take n es)) =
nths (take (Suc_es_n') vs) (set (take n es)) @
nths (take m' (drop (Suc_es_n') vs)) {j. j + length (take (Suc_es_n') vs) : (set (take n es))}"
by (simp add: nths_append)
with empty Suc_es_n'_def have "nths (take (es ! n) vs) (set (take n es)) =
nths (take (Suc (es!n')) vs) (set (take n es))" by simp
with suc1 sub2 have sub3: "nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
nths (take (Suc (es!n')) (verticesFrom f v)) (set (take n es))" by simp
from smaller suc1 have "take (Suc (es ! n)) (verticesFrom f v)
= take (es ! n) (verticesFrom f v) @ [((verticesFrom f v)!(es!n))]"
by (auto simp: take_Suc_conv_app_nth)
with suc1 smaller have
"nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es))) =
nths (take (es ! n) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
@ nths ([((verticesFrom f v)!(es!n))]) {j. j + (es!n) : (insert (es ! n) (set (take n es)))}"
by (auto simp: nths_append)
with sub1 sub3 have "nths (take (Suc (es ! n)) (verticesFrom f v)) (insert (es ! n) (set (take n es)))
= nths (take (Suc (es ! n')) (verticesFrom f v)) (set (take n es)) @ [v']" by auto
with Some suc1 lvs n' show ?thesis by (simp add: take_Suc_conv_app_nth)
qed
qed
qed
lemma natToVertexList_nths: "distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹
incrIndexList es (length es) (length (vertices f)) ⟹
nths (verticesFrom f v) (set es) = removeNones (natToVertexList v f es)"
proof -
assume vors1: "distinct (vertices f)" "v ∈ 𝒱 f"
"incrIndexList es (length es) (length (vertices f))"
define vs where "vs = verticesFrom f v"
with vors1 have lvs: "length vs = length (vertices f)" by (auto intro: verticesFrom_length)
with vors1 vs_def have vors: "distinct (vertices f)" "v ∈ 𝒱 f"
"vs = verticesFrom f v" "incrIndexList es (length es) (length vs)" by auto
with lvs have vsne: "vs ≠ []" by auto
define n where "n = length es"
then have "es!(n - 1) = last es"
proof (cases n)
case 0 with n_def vors show ?thesis by (cases es) auto
next
case (Suc n')
with n_def have small_n': "n' < length es" by arith
from Suc n_def have "take (Suc n') es = es" by auto
with small_n' have "take n' es @ [es!n'] = es" by (simp add: take_Suc_conv_app_nth)
then have "es!n' = last es" by (cases es rule: rev_exhaust) auto
with Suc show ?thesis by auto
qed
with vors have "es!(n - 1) = (length vs) - 1" by auto
with vsne have "Suc (es! (n - 1)) = (length vs)" by auto
then have take_vs: "take (Suc (es!(n - 1))) vs = vs" by auto
from n_def vors have "n = length (natToVertexList v f es)" by auto
then have take_nTVL: "take n (natToVertexList v f es) = natToVertexList v f es" by auto
from n_def have take_es: "take n es = es" by auto
from n_def have "n ≤ length es" by auto
with vors have "nths (take (Suc (es!(n - 1))) vs) (set (take n es))
= removeNones (take n (natToVertexList v f es))" by (rule natToVertexList_nths1)
with take_vs take_nTVL take_es vs_def show ?thesis by simp
qed
lemma filter_Cons2:
"x ∉ set ys ⟹ [y←ys. y = x ∨ P y] = [y←ys. P y]"
by (induct ys) (auto)
lemma natToVertexList_removeNones:
"distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹
incrIndexList es (length es) (length (vertices f)) ⟹
[x←verticesFrom f v. x ∈ set (removeNones (natToVertexList v f es))]
= removeNones (natToVertexList v f es)"
proof -
assume vors: "distinct (vertices f)" "v ∈ 𝒱 f"
"incrIndexList es (length es) (length (vertices f))"
then have dist: "distinct (verticesFrom f v)" by auto
from vors have sub_eq: "nths (verticesFrom f v) (set es)
= removeNones (natToVertexList v f es)" by (rule natToVertexList_nths)
from dist have "[x ← verticesFrom f v.
x ∈ set (nths (verticesFrom f v) (set es))] = removeNones (natToVertexList v f es)"
apply (simp add: filter_in_nths)
by (simp add: sub_eq)
with sub_eq show ?thesis by simp
qed
definition is_duplicateEdge :: "graph ⇒ face ⇒ vertex ⇒ vertex ⇒ bool" where
"is_duplicateEdge g f a b ≡
((a, b) ∈ edges g ∧ (a, b) ∉ edges f ∧ (b, a) ∉ edges f)
∨ ((b, a) ∈ edges g ∧ (b, a) ∉ edges f ∧ (a, b) ∉ edges f)"
definition invalidVertexList :: "graph ⇒ face ⇒ vertex option list ⇒ bool" where
"invalidVertexList g f vs ≡
∃i < |vs|- 1.
case vs!i of None ⇒ False
| Some a ⇒ case vs!(i+1) of None ⇒ False
| Some b ⇒ is_duplicateEdge g f a b"
subsection ‹‹pre_subdivFace(')››
definition pre_subdivFace_face :: "face ⇒ vertex ⇒ vertex option list ⇒ bool" where
"pre_subdivFace_face f v' vOptionList ≡
[v ← verticesFrom f v'. v ∈ set (removeNones vOptionList)]
= (removeNones vOptionList)
∧ ¬ final f ∧ distinct (vertices f)
∧ hd (vOptionList) = Some v'
∧ v' ∈ 𝒱 f
∧ last (vOptionList) = Some (last (verticesFrom f v'))
∧ hd (tl (vOptionList)) ≠ last (vOptionList)
∧ 2 < | vOptionList |
∧ vOptionList ≠ []
∧ tl (vOptionList) ≠ []"
definition pre_subdivFace :: "graph ⇒ face ⇒ vertex ⇒ vertex option list ⇒ bool" where
"pre_subdivFace g f v' vOptionList ≡
pre_subdivFace_face f v' vOptionList ∧ ¬ invalidVertexList g f vOptionList"
definition pre_subdivFace' :: "graph ⇒ face ⇒ vertex ⇒ vertex ⇒ nat ⇒ vertex option list ⇒ bool" where
"pre_subdivFace' g f v' ram1 n vOptionList ≡
¬ final f ∧ v' ∈ 𝒱 f ∧ ram1 ∈ 𝒱 f
∧ v' ∉ set (removeNones vOptionList)
∧ distinct (vertices f)
∧ (
[v ← verticesFrom f v'. v ∈ set (removeNones vOptionList)]
= (removeNones vOptionList)
∧ before (verticesFrom f v') ram1 (hd (removeNones vOptionList))
∧ last (vOptionList) = Some (last (verticesFrom f v'))
∧ vOptionList ≠ []
∧ ((v' = ram1 ∧ (0 < n)) ∨ ((v' = ram1 ∧ (hd (vOptionList) ≠ Some (last (verticesFrom f v')))) ∨ (v' ≠ ram1)))
∧ ¬ invalidVertexList g f vOptionList
∧ (n = 0 ∧ hd (vOptionList) ≠ None ⟶ ¬ is_duplicateEdge g f ram1 (the (hd (vOptionList))))
∨ (vOptionList = [] ∧ v' ≠ ram1)
)"
lemma pre_subdivFace_face_in_f[intro]: "pre_subdivFace_face f v ls ⟹ Some a ∈ set ls ⟹ a ∈ set (verticesFrom f v)"
apply (subgoal_tac "a ∈ set (removeNones ls)") apply (auto simp: pre_subdivFace_face_def)
apply (subgoal_tac "a ∈ set [v←verticesFrom f v . v ∈ set (removeNones ls)]")
apply (thin_tac "[v←verticesFrom f v . v ∈ set (removeNones ls)] = removeNones ls") by auto
lemma pre_subdivFace_in_f[intro]: "pre_subdivFace g f v ls ⟹ Some a ∈ set ls ⟹ a ∈ set (verticesFrom f v)"
by (auto simp: pre_subdivFace_def)
lemma pre_subdivFace_face_in_f'[intro]: "pre_subdivFace_face f v ls ⟹ Some a ∈ set ls ⟹ a ∈ 𝒱 f"
apply (cases "a = v") apply (force simp: pre_subdivFace_face_def)
apply (rule verticesFrom_in') apply (rule pre_subdivFace_face_in_f)
by auto
lemma filter_congs_shorten1: "distinct (verticesFrom f v) ⟹ [v←verticesFrom f v . v = a ∨ v ∈ set vs] = (a # vs)
⟹ [v←verticesFrom f v . v ∈ set vs] = vs"
proof -
assume dist: "distinct (verticesFrom f v)" and eq: "[v←verticesFrom f v . v = a ∨ v ∈ set vs] = (a # vs)"
have rule1: "⋀ vs a ys. distinct vs ⟹ [v←vs . v = a ∨ v ∈ set ys] = a # ys ⟹ [v←vs. v ∈ set ys] = ys"
proof -
fix vs a ys
assume dist: "distinct vs" and ays: "[v←vs . v = a ∨ v ∈ set ys] = a # ys"
then have "distinct ([v←vs . v = a ∨ v ∈ set ys])" by (rule_tac distinct_filter)
with ays have distys: "distinct (a # ys)" by simp
from dist distys ays show "[v←vs. v ∈ set ys] = ys"
apply (induct vs) by (auto split: if_split_asm simp: filter_Cons2)
qed
from dist eq show ?thesis by (rule_tac rule1)
qed
lemma ovl_shorten: "distinct (verticesFrom f v) ⟹
[v←verticesFrom f v . v ∈ set (removeNones (va # vol))] = (removeNones (va # vol))
⟹ [v←verticesFrom f v . v ∈ set (removeNones (vol))] = (removeNones (vol))"
proof -
assume dist: "distinct (verticesFrom f v)"
and vors: "[v←verticesFrom f v . v ∈ set (removeNones (va # vol))] = (removeNones (va # vol))"
then show ?thesis
proof (cases va)
case None with vors Cons show ?thesis by auto
next
case (Some a) with vors dist show ?thesis by (auto intro!: filter_congs_shorten1)
qed
qed
lemma pre_subdivFace_face_distinct: "pre_subdivFace_face f v vol ⟹ distinct (removeNones vol)"
apply (auto dest!: verticesFrom_distinct simp: pre_subdivFace_face_def)
apply (subgoal_tac "distinct ([v←verticesFrom f v . v ∈ set (removeNones vol)])") apply simp
apply (thin_tac "[v←verticesFrom f v . v ∈ set (removeNones vol)] = removeNones vol") by auto
lemma invalidVertexList_shorten: "invalidVertexList g f vol ⟹ invalidVertexList g f (v # vol)"
apply (simp add: invalidVertexList_def) apply auto apply (rule exI) apply safe
apply (subgoal_tac "(Suc i) < | vol |") apply assumption apply arith
apply auto apply (case_tac "vol!i") by auto
lemma pre_subdivFace_pre_subdivFace': "v ∈ 𝒱 f ⟹ pre_subdivFace g f v (vo # vol) ⟹
pre_subdivFace' g f v v 0 (vol)"
proof -
assume vors: "v ∈ 𝒱 f" "pre_subdivFace g f v (vo # vol)"
then have vors': "v ∈ 𝒱 f" "pre_subdivFace_face f v (vo # vol)" "¬ invalidVertexList g f (vo # vol)"
by (auto simp: pre_subdivFace_def)
then have r: "removeNones vol ≠ []" apply (cases "vol" rule: rev_exhaust) by (auto simp: pre_subdivFace_face_def)
then have "Some (hd (removeNones vol)) ∈ set vol" apply (induct vol) apply auto apply (case_tac a) by auto
then have "Some (hd (removeNones vol)) ∈ set (vo # vol)" by auto
with vors' have hd: "hd (removeNones vol) ∈ 𝒱 f" by (rule_tac pre_subdivFace_face_in_f')
from vors' have "Some v = vo" by (auto simp: pre_subdivFace_face_def)
with vors' have "v ∉ set (tl (removeNones (vo # vol)))" apply (drule_tac pre_subdivFace_face_distinct) by auto
with vors' r have ne: "v ≠ hd (removeNones vol)" by (cases "removeNones vol") (auto simp: pre_subdivFace_face_def)
from vors' have dist: "distinct (removeNones (vo # vol))" apply (rule_tac pre_subdivFace_face_distinct) .
from vors' have invalid: "¬ invalidVertexList g f vol" by (auto simp: invalidVertexList_shorten)
from ne hd vors' invalid dist show ?thesis apply (unfold pre_subdivFace'_def)
apply (simp add: pre_subdivFace'_def pre_subdivFace_face_def)
apply safe
apply (rule ovl_shorten)
apply (simp add: pre_subdivFace_face_def) apply assumption
apply (rule before_verticesFrom)
apply simp+
apply (simp add: invalidVertexList_def)
apply (erule allE)
apply (erule impE)
apply (subgoal_tac "0 < |vol|")
apply (thin_tac "Suc 0 < | vol |")
apply assumption
apply simp
apply (simp)
apply (case_tac "vol") apply simp by (simp add: is_duplicateEdge_def)
qed
lemma pre_subdivFace'_distinct: "pre_subdivFace' g f v' v n vol ⟹ distinct (removeNones vol)"
apply (unfold pre_subdivFace'_def)
apply (cases vol) apply simp+
apply (elim conjE)
apply (drule_tac verticesFrom_distinct) apply assumption
apply (subgoal_tac "distinct [v←verticesFrom f v' . v ∈ set (removeNones (a # list))]") apply force
apply (thin_tac "[v←verticesFrom f v' . v ∈ set (removeNones (a # list))] = removeNones (a # list)")
by auto
lemma natToVertexList_pre_subdivFace_face:
"¬ final f ⟹ distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ 2 < |es| ⟹
incrIndexList es (length es) (length (vertices f)) ⟹
pre_subdivFace_face f v (natToVertexList v f es)"
proof -
assume vors: "¬ final f" "distinct (vertices f)" "v ∈ 𝒱 f" "2 < |es|"
"incrIndexList es (length es) (length (vertices f))"
then have lastOvl: "last (natToVertexList v f es) = Some (last (verticesFrom f v))" by auto
from vors have nvl_l: "2 < | natToVertexList v f es |"
by auto
from vors have "distinct [x←verticesFrom f v . x ∈ set (removeNones (natToVertexList v f es))]" by auto
with vors have "distinct (removeNones (natToVertexList v f es))" by (simp add: natToVertexList_removeNones)
with nvl_l lastOvl have hd_last: "hd (tl (natToVertexList v f es)) ≠ last (natToVertexList v f es)" apply auto
apply (cases "natToVertexList v f es") apply simp
apply (case_tac "list" rule: rev_exhaust) apply simp
apply (case_tac "ys") apply simp
apply (case_tac "a") apply simp by simp
from vors lastOvl hd_last nvl_l show ?thesis
apply (auto intro: natToVertexList_removeNones simp: pre_subdivFace_face_def)
apply (cases es) apply auto
apply (cases es) apply auto
apply (subgoal_tac "0 < length list") apply (case_tac list) by (auto split: if_split_asm)
qed
lemma indexToVertexList_pre_subdivFace_face:
"¬ final f ⟹ distinct (vertices f) ⟹ v ∈ 𝒱 f ⟹ 2 < |es| ⟹
incrIndexList es (length es) (length (vertices f)) ⟹
pre_subdivFace_face f v (indexToVertexList f v es)"
apply (subgoal_tac "indexToVertexList f v es = natToVertexList v f es") apply simp
apply (rule natToVertexList_pre_subdivFace_face) apply assumption+
apply (rule indexToVertexList_natToVertexList_eq) by auto
lemma subdivFace_subdivFace'_eq: "pre_subdivFace g f v vol ⟹ subdivFace g f vol = subdivFace' g f v 0 (tl vol)"
by (simp_all add: subdivFace_def pre_subdivFace_def pre_subdivFace_face_def)
lemma pre_subdivFace'_None:
"pre_subdivFace' g f v' v n (None # vol) ⟹
pre_subdivFace' g f v' v (Suc n) vol"
by(auto simp: pre_subdivFace'_def dest:invalidVertexList_shorten
split:if_split_asm)
declare verticesFrom_between [simp del]
lemma verticesFrom_split: "v # tl (verticesFrom f v) = verticesFrom f v" by (auto simp: verticesFrom_Def)
lemma verticesFrom_v: "distinct (vertices f) ⟹ vertices f = a @ v # b ⟹ verticesFrom f v = v # b @ a"
by (simp add: verticesFrom_Def)
lemma splitAt_fst[simp]: "distinct xs ⟹ xs = a @ v # b ⟹ fst (splitAt v xs) = a"
by auto
lemma splitAt_snd[simp]: "distinct xs ⟹ xs = a @ v # b ⟹ snd (splitAt v xs) = b"
by auto
lemma verticesFrom_splitAt_v_fst[simp]:
"distinct (verticesFrom f v) ⟹ fst (splitAt v (verticesFrom f v)) = []"
by (simp add: verticesFrom_Def)
lemma verticesFrom_splitAt_v_snd[simp]:
"distinct (verticesFrom f v) ⟹ snd (splitAt v (verticesFrom f v)) = tl (verticesFrom f v)"
by (simp add: verticesFrom_Def)
lemma filter_distinct_at:
"distinct xs ⟹ xs = (as @ u # bs) ⟹ [v←xs. v = u ∨ P v] = u # us ⟹
[v←bs. P v] = us ∧ [v←as. P v] = []"
apply (subgoal_tac "filter P as @ u # filter P bs = [] @ u # us")
apply (drule local_help') by (auto simp: filter_Cons2)
lemma filter_distinct_at3: "distinct xs ⟹ xs = (as @ u # bs) ⟹
[v←xs. v = u ∨ P v] = u # us ⟹ ∀ z ∈ set zs. z ∈ set as ∨ ¬ ( P z) ⟹
[v←zs@bs. P v] = us"
apply (drule filter_distinct_at) apply assumption+ apply simp
by (induct zs) auto
lemma filter_distinct_at4: "distinct xs ⟹ xs = (as @ u # bs)
⟹ [v←xs. v = u ∨ v ∈ set us] = u # us
⟹ set zs ∩ set us ⊆ {u} ∪ set as
⟹ [v ← zs@bs. v ∈ set us] = us"
proof -
assume vors: "distinct xs" "xs = (as @ u # bs)"
"[v←xs. v = u ∨ v ∈ set us] = u # us"
"set zs ∩ set us ⊆ {u} ∪ set as"
then have "distinct ([v←xs. v = u ∨ v ∈ set us])" apply (rule_tac distinct_filter) by simp
with vors have dist: "distinct (u # us)" by auto
with vors show ?thesis
apply (rule_tac filter_distinct_at3) by assumption+ auto
qed
lemma filter_distinct_at5: "distinct xs ⟹ xs = (as @ u # bs)
⟹ [v←xs. v = u ∨ v ∈ set us] = u # us
⟹ set zs ∩ set xs ⊆ {u} ∪ set as
⟹ [v ← zs@bs. v ∈ set us] = us"
proof -
assume vors: "distinct xs" "xs = (as @ u # bs)"
"[v←xs. v = u ∨ v ∈ set us] = u # us"
"set zs ∩ set xs ⊆ {u} ∪ set as"
have "set ([v←xs. v = u ∨ v ∈ set us]) ⊆ set xs" by auto
with vors have "set (u # us) ⊆ set xs" by simp
then have "set us ⊆ set xs" by simp
with vors have "set zs ∩ set us ⊆ set zs ∩ insert u (set as ∪ set bs)" by auto
with vors show ?thesis apply (rule_tac filter_distinct_at4) apply assumption+ by auto
qed
lemma filter_distinct_at6: "distinct xs ⟹ xs = (as @ u # bs)
⟹ [v←xs. v = u ∨ v ∈ set us] = u # us
⟹ set zs ∩ set xs ⊆ {u} ∪ set as
⟹ [v ← zs@bs. v ∈ set us] = us ∧ [v ← bs. v ∈ set us] = us"
proof -
assume vors: "distinct xs" "xs = (as @ u # bs)"
"[v ← xs. v = u ∨ v ∈ set us] = u # us"
"set zs ∩ set xs ⊆ {u} ∪ set as"
then show ?thesis apply (rule_tac conjI) apply (rule_tac filter_distinct_at5) apply assumption+
apply (drule filter_distinct_at) apply assumption+ by auto
qed
lemma filter_distinct_at_special:
"distinct xs ⟹ xs = (as @ u # bs)
⟹ [v←xs. v = u ∨ v ∈ set us] = u # us
⟹ set zs ∩ set xs ⊆ {u} ∪ set as
⟹ us = hd_us # tl_us
⟹ [v ← zs@bs. v ∈ set us] = us ∧ hd_us ∈ set bs"
proof -
assume vors: "distinct xs" "xs = (as @ u # bs)"
"[v←xs. v = u ∨ v ∈ set us] = u # us"
"set zs ∩ set xs ⊆ {u} ∪ set as"
"us = hd_us # tl_us"
then have "[v ← zs@bs. v ∈ set us] = us ∧ [v←bs. v ∈ set us] = us"
by (rule_tac filter_distinct_at6)
with vors show ?thesis apply (rule_tac conjI) apply safe apply simp
apply (subgoal_tac "set (hd_us # tl_us) ⊆ set bs") apply simp
apply (subgoal_tac "set [v←bs . v = hd_us ∨ v ∈ set tl_us] ⊆ set bs") apply simp
by (rule_tac filter_is_subset)
qed
lemma pre_subdivFace'_Some1':
assumes pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)"
and pre_fdg: "pre_splitFace g v u f ws"
and fdg: "f21 = fst (snd (splitFace g v u f ws))"
and g': "g' = snd (snd (splitFace g v u f ws))"
shows "pre_subdivFace' g' f21 v' u 0 vol"
proof (cases "vol = []")
case True then show ?thesis using pre_add fdg pre_fdg
apply(unfold pre_subdivFace'_def pre_splitFace_def)
apply (simp add: splitFace_def split_face_def split_def del:distinct.simps)
apply (rule conjI)
apply(clarsimp)
apply(rule before_between)
apply(erule (5) rotate_before_vFrom)
apply(erule not_sym)
apply (clarsimp simp:between_distinct between_not_r1 between_not_r2)
apply(blast dest:inbetween_inset)
done
next
case False
with pre_add
have "removeNones vol ≠ []" apply (cases "vol" rule: rev_exhaust) by (auto simp: pre_subdivFace'_def)
then have removeNones_split: "removeNones vol = hd (removeNones vol) # tl (removeNones vol)" by auto
from pre_add have dist: "distinct (removeNones ((Some u) # vol))" by (rule_tac pre_subdivFace'_distinct)
from pre_add have v': "v' ∈ 𝒱 f" by (auto simp: pre_subdivFace'_def)
hence "(vertices f) ≅ (verticesFrom f v')" by (rule verticesFrom_congs)
hence set_eq: "set (verticesFrom f v') = 𝒱 f"
apply (rule_tac sym) by (rule congs_pres_nodes)
from pre_fdg fdg have dist_f21: "distinct (vertices f21)" by auto
from pre_add have pre_bet': "pre_between (verticesFrom f v') u v"
apply (simp add: pre_between_def pre_subdivFace'_def)
apply (elim conjE) apply (thin_tac "n = 0 ⟶ ¬ is_duplicateEdge g f v u")
apply (thin_tac "v' = v ∧ 0 < n ∨ v' = v ∧ u ≠ last (verticesFrom f v') ∨ v' ≠ v")
apply (auto simp add: before_def)
apply (subgoal_tac "distinct (verticesFrom f v')") apply simp
apply (rule_tac verticesFrom_distinct) by auto
with pre_add have pre_bet: "pre_between (vertices f) u v"
apply (subgoal_tac "(vertices f) ≅ (verticesFrom f v')")
apply (simp add: pre_between_def pre_subdivFace'_def)
by (auto dest: congs_pres_nodes intro: verticesFrom_congs simp: pre_subdivFace'_def)
from pre_bet pre_add have bet_eq[simp]: "between (vertices f) u v = between (verticesFrom f v') u v"
by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)
from fdg have f21_split_face: "f21 = snd (split_face f v u ws)"
by (simp add: splitFace_def split_def)
then have f21: "f21 = Face (u # between (vertices f) u v @ v # ws) Nonfinal"
by (simp add: split_face_def)
with pre_add pre_bet'
have vert_f21: "vertices f21
= u # snd (splitAt u (verticesFrom f v')) @ fst (splitAt v (verticesFrom f v')) @ v # ws"
apply (drule_tac pre_between_symI)
by (auto simp: pre_subdivFace'_def between_simp2 intro: pre_between_symI)
moreover
from pre_add have "v ∈ set (verticesFrom f v')" by (auto simp: pre_subdivFace'_def before_def)
then have "verticesFrom f v' =
fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
by (auto dest: splitAt_ram)
then have m: "v' # tl (verticesFrom f v')
= fst (splitAt v (verticesFrom f v')) @ v # snd (splitAt v (verticesFrom f v'))"
by (simp add: verticesFrom_split)
then have vv': "v ≠ v' ⟹ fst (splitAt v (verticesFrom f v'))
= v' # tl (fst (splitAt v (verticesFrom f v')))"
by (cases "fst (splitAt v (verticesFrom f v'))") auto
ultimately have "v ≠ v' ⟹ vertices f21
= u # snd (splitAt u (verticesFrom f v')) @ v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws"
by auto
moreover
with f21 have rule2: "v' ∈ 𝒱 f21" by auto
with dist_f21 have dist_f21_v': "distinct (verticesFrom f21 v')" by auto
ultimately have m1: "v ≠ v' ⟹ verticesFrom f21 v'
= v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # snd (splitAt u (verticesFrom f v'))"
apply auto
apply (subgoal_tac "snd (splitAt v' (vertices f21)) = tl (fst (splitAt v (verticesFrom f v'))) @ v # ws")
apply (subgoal_tac "fst (splitAt v' (vertices f21)) = u # snd (splitAt u (verticesFrom f v'))")
apply (subgoal_tac "verticesFrom f21 v' = v' # snd (splitAt v' (vertices f21)) @ fst (splitAt v' (vertices f21))")
apply simp
apply (intro verticesFrom_v dist_f21) apply force
apply (subgoal_tac "distinct (vertices f21)") apply simp
apply (rule_tac dist_f21)
apply (subgoal_tac "distinct (vertices f21)") apply simp
by (rule_tac dist_f21)
from pre_add have dist_vf_v': "distinct (verticesFrom f v')" by (simp add: pre_subdivFace'_def)
with vert_f21 have m2: "v = v' ⟹ verticesFrom f21 v' = v' # ws @ u # snd (splitAt u (verticesFrom f v'))"
apply auto apply (intro verticesFrom_v dist_f21) by simp
from pre_add have u: "u ∈ set (verticesFrom f v')" by (fastforce simp: pre_subdivFace'_def before_def)
then have split_u: "verticesFrom f v'
= fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
by (auto dest!: splitAt_ram)
then have rule1': "[v ← snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)] = removeNones vol"
proof -
from split_u have "v' # tl (verticesFrom f v')
= fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
by (simp add: verticesFrom_split)
have "help": "set [] ∩ set (verticesFrom f v') ⊆ {u} ∪ set (fst (splitAt u (verticesFrom f v')))" by auto
from split_u dist_vf_v' pre_add
have "[v ← [] @ snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)] = removeNones vol"
apply (rule_tac filter_distinct_at5) apply assumption+
apply (simp add: pre_subdivFace'_def) by (rule "help")
then show ?thesis by auto
qed
then have inSnd_u: "⋀ x. x ∈ set (removeNones vol) ⟹ x ∈ set (snd (splitAt u (verticesFrom f v')))"
apply (subgoal_tac "x ∈ set [v ← snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)] ⟹
x ∈ set (snd (splitAt u (verticesFrom f v')))")
apply force apply (thin_tac "[v ← snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)] = removeNones vol")
by simp
from split_u dist_vf_v' have notinFst_u: "⋀ x. x ∈ set (removeNones vol) ⟹
x ∉ set ((fst (splitAt u (verticesFrom f v'))) @ [u])" apply (drule_tac inSnd_u)
apply (subgoal_tac "distinct ( fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))")
apply (thin_tac "verticesFrom f v'
= fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))")
apply simp apply safe
apply (subgoal_tac "x ∈ set (fst (splitAt u (verticesFrom f v'))) ∩ set (snd (splitAt u (verticesFrom f v')))")
apply simp
apply (thin_tac "set (fst (splitAt u (verticesFrom f v'))) ∩ set (snd (splitAt u (verticesFrom f v'))) = {}")
apply simp
by (simp only:)
from rule2 v' have "⋀ a b. is_nextElem (vertices f) a b ∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol) ⟹
is_nextElem (vertices f21) a b"
proof -
fix a b
assume vors: "is_nextElem (vertices f) a b ∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol)"
define vor_u where "vor_u = fst (splitAt u (verticesFrom f v'))"
define nach_u where "nach_u = snd (splitAt u (verticesFrom f v'))"
from vors v' have "is_nextElem (verticesFrom f v') a b" by (simp add: verticesFrom_is_nextElem)
moreover
from vors inSnd_u nach_u_def have "a ∈ set (nach_u)" by auto
moreover
from vors inSnd_u nach_u_def have "b ∈ set (nach_u)" by auto
moreover
from split_u vor_u_def nach_u_def have "verticesFrom f v' = vor_u @ u # nach_u" by auto
moreover
note dist_vf_v'
ultimately have "is_sublist [a,b] (nach_u)" apply (simp add: is_nextElem_def split:if_split_asm)
apply (subgoal_tac "b ≠ hd (vor_u @ u # nach_u)")
apply simp
apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
apply (drule is_sublist_at5)
apply simp
apply simp
apply (erule disjE)
apply (drule is_sublist_in1)+
apply (subgoal_tac "b ∈ set vor_u ∩ set nach_u") apply simp
apply (thin_tac "set vor_u ∩ set nach_u = {}")
apply simp
apply (erule disjE)
apply (subgoal_tac "distinct ([u] @ nach_u)")
apply (drule is_sublist_at5)
apply simp
apply simp
apply (erule disjE)
apply simp
apply simp
apply simp
apply (subgoal_tac "distinct (vor_u @ (u # nach_u))")
apply (drule is_sublist_at5) apply simp
apply (erule disjE)
apply (drule is_sublist_in1)+
apply simp
apply (erule disjE)
apply (drule is_sublist_in1)+ apply simp
apply simp
apply simp
apply simp
apply (cases "vor_u") by auto
with nach_u_def have "is_sublist [a,b] (snd (splitAt u (verticesFrom f v')))" by auto
then have "is_sublist [a,b] (verticesFrom f21 v')"
apply (cases "v = v'") apply (simp_all add: m1 m2)
apply (subgoal_tac "is_sublist [a, b] ((v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) @ [])")
apply simp apply (rule is_sublist_add) apply simp
apply (subgoal_tac "is_sublist [a, b]
((v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u]) @ (snd (splitAt u (verticesFrom f v'))) @ [])")
apply simp apply (rule is_sublist_add) by simp
with rule2 show "is_nextElem (vertices f) a b ∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol) ⟹
is_nextElem (vertices f21) a b" apply (simp add: verticesFrom_is_nextElem) by (auto simp: is_nextElem_def)
qed
with pre_add dist_f21 have rule5':
"⋀ a b. (a,b) ∈ edges f ∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol) ⟹ (a, b) ∈ edges f21"
by (simp add: is_nextElem_edges_eq pre_subdivFace'_def)
have rule1: "[v←verticesFrom f21 v' . v ∈ set (removeNones vol)]
= removeNones vol ∧ hd (removeNones vol) ∈ set (snd (splitAt u (verticesFrom f v')))"
proof (cases "v = v'")
case True
from split_u have "v' # tl (verticesFrom f v')
= fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v'))"
by (simp add: verticesFrom_split)
then have "u ≠ v' ⟹ fst (splitAt u (verticesFrom f v'))
= v' # tl (fst (splitAt u (verticesFrom f v')))" by (cases "fst (splitAt u (verticesFrom f v'))") auto
moreover
have "v' ∈ set (v' # tl (fst (splitAt u (verticesFrom f v'))))" by simp
ultimately have "u ≠ v' ⟹ v' ∈ set (fst (splitAt u (verticesFrom f v')))" by simp
moreover
from pre_fdg have "set (v' # ws @ [u]) ∩ set (verticesFrom f v') ⊆ {v', u}"
apply (simp add: set_eq)
by (unfold pre_splitFace_def) auto
ultimately have "help": "set (v' # ws @ [u]) ∩ set (verticesFrom f v')
⊆ {u} ∪ set (fst (splitAt u (verticesFrom f v')))" apply (rule_tac subset_trans)
apply assumption apply (cases "u = v'") by simp_all
from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
"[v ← (v' # ws @ [u]) @ snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)]
= removeNones vol ∧ hd (removeNones vol) ∈ set (snd (splitAt u (verticesFrom f v')))"
apply (rule_tac filter_distinct_at_special) apply assumption+
apply (simp add: pre_subdivFace'_def) apply (rule "help") .
with True m2 show ?thesis by auto
next
case False
with m1 dist_f21_v' have ne_uv': "u ≠ v'" by auto
define fst_u where "fst_u = fst (splitAt u (verticesFrom f v'))"
define fst_v where "fst_v = fst (splitAt v (verticesFrom f v'))"
from pre_add u dist_vf_v' have "v ∈ set (fst (splitAt u (verticesFrom f v')))"
apply (rule_tac before_dist_r1) by (auto simp: pre_subdivFace'_def)
with fst_u_def have "fst_u = fst (splitAt v (fst (splitAt u (verticesFrom f v'))))
@ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))"
by (auto dest: splitAt_ram)
with pre_add fst_v_def pre_bet' have fst_u':"fst_u
= fst_v @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v'))))" by (simp add: pre_subdivFace'_def)
from pre_fdg have "set (v # ws @ [u]) ∩ set (verticesFrom f v') ⊆ {v, u}" apply (simp add: set_eq)
by (unfold pre_splitFace_def) auto
with fst_u' have "set (v # ws @ [u]) ∩ set (verticesFrom f v') ⊆ {u} ∪ set fst_u" by auto
moreover
from fst_u' have "set fst_v ⊆ set fst_u" by auto
ultimately
have "(set (v # ws @ [u]) ∪ set fst_v) ∩ set (verticesFrom f v') ⊆ {u} ∪ set fst_u" by auto
with fst_u_def fst_v_def
have "set (fst (splitAt v (verticesFrom f v')) @ v # ws @ [u]) ∩ set (verticesFrom f v')
⊆ {u} ∪ set (fst (splitAt u (verticesFrom f v')))" by auto
moreover
with False vv' have "v' # tl (fst (splitAt v (verticesFrom f v')))
= fst (splitAt v (verticesFrom f v'))" by auto
ultimately have "set ((v' # tl (fst (splitAt v (verticesFrom f v')))) @ v # ws @ [u]) ∩ set (verticesFrom f v')
⊆ {u} ∪ set (fst (splitAt u (verticesFrom f v')))"
by (simp only:)
then have "help": "set (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u]) ∩ set (verticesFrom f v')
⊆ {u} ∪ set (fst (splitAt u (verticesFrom f v')))" by auto
from split_u dist_vf_v' pre_add pre_fdg removeNones_split have
"[v ← (v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ [u])
@ snd (splitAt u (verticesFrom f v')) . v ∈ set (removeNones vol)]
= removeNones vol ∧ hd (removeNones vol) ∈ set (snd (splitAt u (verticesFrom f v')))"
apply (rule_tac filter_distinct_at_special) apply assumption+
apply (simp add: pre_subdivFace'_def) apply (rule "help") .
with False m1 show ?thesis by auto
qed
from rule1 have "(hd (removeNones vol)) ∈ set (snd (splitAt u (verticesFrom f v')))" by auto
with m1 m2 dist_f21_v' have rule3: "before (verticesFrom f21 v') u (hd (removeNones vol))"
proof -
assume hd_ram: "(hd (removeNones vol)) ∈ set (snd (splitAt u (verticesFrom f v')))"
from m1 m2 dist_f21_v' have "distinct (snd (splitAt u (verticesFrom f v')))" apply (cases "v = v'")
by auto
moreover
define z1 where "z1 = fst (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
define z2 where "z2 = snd (splitAt (hd (removeNones vol)) (snd (splitAt u (verticesFrom f v'))))"
note z1_def z2_def hd_ram
ultimately have "snd (splitAt u (verticesFrom f v')) = z1 @ (hd (removeNones vol)) # z2"
by (auto intro: splitAt_ram)
with m1 m2 show ?thesis apply (cases "v = v'") apply (auto simp: before_def)
apply (intro exI )
apply (subgoal_tac "v' # ws @ u # z1 @ hd (removeNones vol) # z2 = (v' # ws) @ u # z1 @ hd (removeNones vol) # z2")
apply assumption apply simp
apply (intro exI )
apply (subgoal_tac "v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws @ u # z1 @ hd (removeNones vol) # z2 =
(v' # tl (fst (splitAt v (verticesFrom f v'))) @ v # ws) @ u # z1 @ hd (removeNones vol) # z2")
apply assumption by simp
qed
from rule1 have ne:"(hd (removeNones vol)) ∈ set (snd (splitAt u (verticesFrom f v')))" by auto
with m1 m2 have "last (verticesFrom f21 v') = last (snd (splitAt u (verticesFrom f v')))"
apply (cases "snd (splitAt u (verticesFrom f v'))" rule: rev_exhaust) apply simp_all
apply (cases "v = v'") by simp_all
moreover
from ne have "last (fst (splitAt u (verticesFrom f v')) @ u # snd (splitAt u (verticesFrom f v')))
= last (snd (splitAt u (verticesFrom f v')))" by auto
moreover
note split_u
ultimately have rule4: "last (verticesFrom f v') = last (verticesFrom f21 v')" by simp
have l: "⋀ a b f v. v ∈ set (vertices f) ⟹ is_nextElem (vertices f) a b = is_nextElem (verticesFrom f v) a b "
apply (rule is_nextElem_congs_eq) by (rule verticesFrom_congs)
define f12 where "f12 = fst (split_face f v u ws)"
then have f12_fdg: "f12 = fst (splitFace g v u f ws)"
by (simp add: splitFace_def split_def)
from pre_bet pre_add have bet_eq2[simp]: "between (vertices f) v u = between (verticesFrom f v') v u"
apply (drule_tac pre_between_symI)
by (auto intro: verticesFrom_between simp: pre_subdivFace'_def)
from f12_fdg have f12_split_face: "f12 = fst (split_face f v u ws)"
by (simp add: splitFace_def split_def)
then have f12: "f12 = Face (rev ws @ v # between (verticesFrom f v') v u @ [u]) Nonfinal"
by (simp add: split_face_def)
then have "vertices f12 = rev ws @ v # between (verticesFrom f v') v u @ [u]" by simp
with pre_add pre_bet' have vert_f12: "vertices f12
= rev ws @ v # snd (splitAt v (fst (splitAt u (verticesFrom f v')))) @ [u]"
apply (subgoal_tac "between (verticesFrom f v') v u = fst (splitAt u (snd (splitAt v (verticesFrom f v'))))")
apply (simp add: pre_subdivFace'_def)
apply (rule between_simp1)
apply (simp add: pre_subdivFace'_def)
apply (rule pre_between_symI) .
with dist_f21_v' have removeNones_vol_not_f12: "⋀ x. x ∈ set (removeNones vol) ⟹ x ∉ set (vertices f12)"
apply (frule_tac notinFst_u) apply (drule inSnd_u) apply simp
apply (case_tac "v = v'") apply (simp add: m1 m2)
apply (rule conjI) apply force
apply (rule conjI) apply (rule ccontr) apply simp
apply (subgoal_tac "x ∈ set ws ∩ set (snd (splitAt u (verticesFrom f v')))")
apply simp apply (elim conjE)
apply (thin_tac "set ws ∩ set (snd (splitAt u (verticesFrom f v'))) = {}")
apply simp
apply force
apply (simp add: m1 m2)
apply (rule conjI) apply force
apply (rule conjI) apply (rule ccontr) apply simp
apply (subgoal_tac "x ∈ set ws ∩ set (snd (splitAt u (verticesFrom f v')))")
apply simp apply (elim conjE)
apply (thin_tac "set ws ∩ set (snd (splitAt u (verticesFrom f v'))) = {}") apply simp
by force
from pre_fdg f12_split_face have dist_f12: "distinct (vertices f12)" by (auto intro: split_face_distinct1')
then have removeNones_vol_edges_not_f12: "⋀ x y. x ∈ set (removeNones vol) ⟹ (x,y) ∉ edges f12"
apply (drule_tac removeNones_vol_not_f12) by auto
from dist_f12 have removeNones_vol_edges_not_f12': "⋀ x y. y ∈ set (removeNones vol) ⟹ (x,y) ∉ edges f12"
apply (drule_tac removeNones_vol_not_f12) by auto
from f12_fdg pre_fdg g' fdg have face_set_eq: "ℱ g' ∪ {f} = {f12, f21} ∪ ℱ g"
apply (rule_tac splitFace_faces_1)
by (simp_all)
have rule5'': "⋀ a b. (a,b) ∈ edges g' ∧ (a,b) ∉ edges g
∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol) ⟹ (a, b) ∈ edges f21"
apply (simp add: edges_graph_def) apply safe
apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
apply (subgoal_tac "x ∈ ℱ g' ∪ {f}") apply (thin_tac "x ≠ f")
apply (thin_tac "x ∈ set (faces g')") apply (simp only: add: face_set_eq)
apply safe apply (drule removeNones_vol_edges_not_f12) by auto
have rule5''': "⋀ a b. (a,b) ∈ edges g' ∧ (a,b) ∉ edges g
∧ a ∈ set (removeNones vol) ∧ b ∈ set (removeNones vol) ⟹ (a, b) ∈ edges f21"
apply (simp add: edges_graph_def) apply safe
apply (case_tac "x = f") apply simp apply (rule rule5') apply safe
apply (subgoal_tac "x ∈ ℱ g' ∪ {f}") apply (thin_tac "x ≠ f")
apply (thin_tac "x ∈ ℱ g'") apply (simp only: add: face_set_eq)
apply safe apply (drule removeNones_vol_edges_not_f12) by auto
from pre_fdg fdg f12_fdg g' have edges_g'1: "ws ≠ [] ⟹ edges g' = edges g ∪ Edges ws ∪ Edges(rev ws) ∪
{(u, last ws), (hd ws, v), (v, hd ws), (last ws, u)}"
apply (rule_tac splitFace_edges_g') apply simp
apply (subgoal_tac "(f12, f21, g') = splitFace g v u f ws") apply assumption by auto
from pre_fdg fdg f12_fdg g' have edges_g'2: "ws = [] ⟹ edges g' = edges g ∪
{(v, u), (u, v)}"
apply (rule_tac splitFace_edges_g'_vs) apply simp
apply (subgoal_tac "(f12, f21, g') = splitFace g v u f []") apply assumption by auto
from f12_split_face f21_split_face have split: "(f12,f21) = split_face f v u ws" by simp
from pre_add have "¬ invalidVertexList g f vol"
by (auto simp: pre_subdivFace'_def dest: invalidVertexList_shorten)
then have rule5: "¬ invalidVertexList g' f21 vol"
apply (simp add: invalidVertexList_def)
apply (intro allI impI)
apply (case_tac "vol!i") apply simp+
apply (case_tac "vol!Suc i") apply simp+
apply (subgoal_tac "¬ is_duplicateEdge g f a aa")
apply (thin_tac "∀i<|vol| - Suc 0. ¬ (case vol ! i of None ⇒ False
| Some a ⇒ case_option False (is_duplicateEdge g f a) (vol ! (i+1)))")
apply (simp add: is_duplicateEdge_def)
apply (subgoal_tac "a ∈ set (removeNones vol) ∧ aa ∈ set (removeNones vol)")
apply (rule conjI)
apply (rule impI)
apply (case_tac "(a, aa) ∈ edges f")
apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (case_tac "(aa, a) ∈ edges f")
apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply simp
apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
apply (subgoal_tac "pre_split_face f v u []")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
apply simp
apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
apply (case_tac "a = v ∧ aa = u") apply simp apply simp
apply (rule split)
apply (subgoal_tac "pre_split_face f v u ws") apply simp
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (frule edges_g'1) apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
apply simp
apply (case_tac "a = u ∧ aa = last ws") apply simp apply simp
apply (case_tac "a = hd ws ∧ aa = v") apply simp apply simp
apply (case_tac "a = v ∧ aa = hd ws") apply simp apply simp
apply (case_tac "a = last ws ∧ aa = u") apply simp apply simp
apply (case_tac "(a, aa) ∈ Edges ws") apply simp
apply simp
apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
apply (force)
apply (rule split)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (rule impI)
apply (case_tac "(aa,a) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (case_tac "(a,aa) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply simp
apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
apply (subgoal_tac "pre_split_face f v u []")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
apply simp
apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
apply force
apply (rule split)
apply (subgoal_tac "pre_split_face f v u ws") apply simp
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (frule edges_g'1) apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
apply (force)
apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
apply (force)
apply (rule split)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (rule conjI)
apply (subgoal_tac "Some a ∈ set vol") apply (induct vol) apply simp apply force
apply (subgoal_tac "vol ! i ∈ set vol") apply simp
apply (rule nth_mem) apply arith
apply (subgoal_tac "Some aa ∈ set vol") apply (induct vol) apply simp apply force
apply (subgoal_tac "vol ! (Suc i) ∈ set vol") apply simp apply (rule nth_mem) apply arith
by auto
from pre_fdg dist_f21 v' have dists: "distinct (vertices f)" "distinct (vertices f12)"
"distinct (vertices f21)" "v' ∈ 𝒱 f"
apply auto defer
apply (drule splitFace_distinct2) apply (simp add: f12_fdg)
apply (unfold pre_splitFace_def) by simp
with pre_fdg have edges_or: "⋀ a b. (a,b) ∈ edges f ⟹ (a,b) ∈ edges f12 ∨ (a,b) ∈ edges f21"
apply (rule_tac split_face_edges_or) apply (simp add: f12_split_face f21_split_face)
by simp+
from pre_fdg have dist_f: "distinct (vertices f)" apply (unfold pre_splitFace_def) by simp
from g' have edges_g': "edges g'
= (UN h:set(replace f [snd (split_face f v u ws)] (faces g)). edges h)
∪ edges (fst (split_face f v u ws))"
by (auto simp add: splitFace_def split_def edges_graph_def)
from pre_fdg edges_g' have edges_g'_or:
"⋀ a b. (a,b) ∈ edges g' ⟹
(a,b) ∈ edges g ∨ (a,b) ∈ edges f12 ∨ (a,b) ∈ edges f21"
apply simp apply (case_tac "(a, b) ∈ edges (fst (split_face f v u ws))")
apply (simp add:f12_split_face) apply simp
apply (elim bexE) apply (simp add: f12_split_face) apply (case_tac "x ∈ ℱ g")
apply (induct g) apply (simp add: edges_graph_def) apply (rule disjI1)
apply (rule bexI) apply simp apply simp
apply (drule replace1) apply simp by (simp add: f21_split_face)
have rule6: "0 < |vol| ⟹ ¬ invalidVertexList g f (Some u # vol) ⟹
(∃y. hd vol = Some y) ⟶ ¬ is_duplicateEdge g' f21 u (the (hd vol))"
apply (rule impI)
apply (erule exE) apply simp apply (case_tac vol) apply simp+
apply (simp add: invalidVertexList_def) apply (erule allE) apply (erule impE) apply force
apply (simp)
apply (subgoal_tac "y ∉ 𝒱 f12") defer apply (rule removeNones_vol_not_f12) apply simp
apply (simp add: is_duplicateEdge_def)
apply (subgoal_tac "y ∈ set (removeNones vol)")
apply (rule conjI)
apply (rule impI)
apply (case_tac "(u, y) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12')
apply (rule pre_splitFace_pre_split_face) apply simp apply (rule pre_fdg)
apply (case_tac "(y, u) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp
apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply simp apply (rule pre_fdg)
apply simp
apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
apply (subgoal_tac "pre_split_face f v u []")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet_vs) apply simp apply simp apply simp
apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
apply force
apply (rule split)
apply (subgoal_tac "pre_split_face f v u ws") apply simp
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (frule edges_g'1) apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
apply (force)
apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
apply (force)
apply (rule split)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (rule impI)
apply (case_tac "(u, y) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp apply (simp add: removeNones_vol_edges_not_f12')
apply (rule pre_splitFace_pre_split_face) apply simp apply (rule pre_fdg)
apply (case_tac "(y, u) ∈ edges f") apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (frule split_face_edges_or [OF split]) apply simp apply (simp add: removeNones_vol_edges_not_f12)
apply (rule pre_splitFace_pre_split_face) apply simp apply (rule pre_fdg)
apply simp
apply (case_tac "ws = []") apply (frule edges_g'2) apply simp
apply (subgoal_tac "pre_split_face f v u []")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet_vs) apply simp apply simp
apply simp
apply (frule split_face_edges_f21_vs) apply simp apply simp apply simp
apply force
apply (rule split)
apply (subgoal_tac "pre_split_face f v u ws") apply simp
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
apply (frule edges_g'1) apply simp
apply (subgoal_tac "pre_split_face f v u ws")
apply (subgoal_tac "(f12, f21) = split_face f v u ws")
apply (case_tac "between (vertices f) u v = []")
apply (frule split_face_edges_f21_bet) apply simp apply simp apply simp
apply (force)
apply (frule split_face_edges_f21) apply simp apply simp apply simp apply simp
apply (force)
apply (rule split)
apply (rule pre_splitFace_pre_split_face) apply (rule pre_fdg)
by simp
have u21: "u ∈ 𝒱 f21" by(simp add:f21)
from fdg have "¬ final f21"
by(simp add:splitFace_def split_face_def split_def)
with pre_add rule1 rule2 rule3 rule4 rule5 rule6 dist_f21 False dist u21
show ?thesis by (simp_all add: pre_subdivFace'_def l)
qed
lemma before_filter: "⋀ ys. filter P xs = ys ⟹ distinct xs ⟹ before ys u v ⟹ before xs u v"
supply subst_all [simp del]
apply (subgoal_tac "P u")
apply (subgoal_tac "P v")
apply (subgoal_tac "pre_between xs u v")
apply (rule ccontr) apply (simp add: before_xor)
apply (subgoal_tac "before ys v u")
apply (subgoal_tac "¬ before ys v u")
apply simp
apply (rule before_dist_not1) apply force apply simp
apply (simp add: before_def) apply (elim exE) apply simp
apply (subgoal_tac "a @ u # b @ v # c = filter P aa @ v # filter P ba @ u # filter P ca")
apply (intro exI) apply assumption
apply simp
apply (subgoal_tac "u ∈ set ys ∧ v ∈ set ys ∧ u ≠ v") apply (simp add: pre_between_def) apply force
apply (subgoal_tac "distinct ys")
apply (simp add: before_def) apply (elim exE) apply simp
apply force
apply (subgoal_tac "v ∈ set (filter P xs)") apply force
apply (simp add: before_def) apply (elim exE) apply simp
apply (subgoal_tac "u ∈ set (filter P xs)") apply force
apply (simp add: before_def) apply (elim exE) by simp
lemma pre_subdivFace'_Some2: "pre_subdivFace' g f v' v 0 ((Some u) # vol) ⟹ pre_subdivFace' g f v' u 0 vol"
apply (cases "vol = []")
apply (simp add: pre_subdivFace'_def)
apply (cases "u = v'") apply simp
apply(rule verticesFrom_in')
apply(rule last_in_set)
apply(simp add:verticesFrom_Def)
apply clarsimp
apply (simp add: pre_subdivFace'_def)
apply (elim conjE)
apply (thin_tac "v' = v ∧ u ≠ last (verticesFrom f v') ∨ v' ≠ v")
apply auto
apply(rule verticesFrom_in'[where v = v'])
apply(clarsimp simp:before_def)
apply simp
apply (rule ovl_shorten) apply simp
apply (subgoal_tac "[v ← verticesFrom f v' . v ∈ set (removeNones ((Some u) # vol))] = removeNones ((Some u) # vol)")
apply assumption
apply simp
apply (rule before_filter)
apply assumption
apply simp
apply (simp add: before_def)
apply (intro exI)
apply (subgoal_tac "u # removeNones vol = [] @ u # [] @ hd (removeNones vol) # tl (removeNones vol)") apply assumption
apply simp
apply (subgoal_tac "removeNones vol ≠ []") apply simp
apply (cases vol rule: rev_exhaust) apply simp_all
apply (simp add: invalidVertexList_shorten)
apply (simp add: is_duplicateEdge_def)
apply (case_tac "vol") apply simp
apply simp
apply (simp add: invalidVertexList_def)
apply (elim allE)
apply (rotate_tac -1)
apply (erule impE)
apply (subgoal_tac "0 < Suc |list|")
apply assumption
apply simp
apply simp
by (simp add: is_duplicateEdge_def)
lemma pre_subdivFace'_preFaceDiv: "pre_subdivFace' g f v' v n ((Some u) # vol)
⟹ f ∈ ℱ g ⟹ (f ∙ v = u ⟶ n ≠ 0) ⟹ 𝒱 f ⊆ 𝒱 g
⟹ pre_splitFace g v u f [countVertices g ..< countVertices g + n]"
proof -
assume pre_add: "pre_subdivFace' g f v' v n ((Some u) # vol)" and f: "f ∈ ℱ g"
and nextVert: "(f ∙ v = u ⟶ n ≠ 0)" and subset: "𝒱 f ⊆ 𝒱 g"
have "distinct [countVertices g ..< countVertices g + n]" by (induct n) auto
moreover
have "𝒱 g ∩ set [countVertices g ..< countVertices g + n] = {}"
apply (cases g) by auto
with subset have "𝒱 f ∩ set [countVertices g ..< countVertices g + n] = {}" by auto
moreover
from pre_add have "𝒱 f = set (verticesFrom f v')" apply (intro congs_pres_nodes verticesFrom_congs)
by (simp add: pre_subdivFace'_def)
with pre_add have "help": "v ∈ 𝒱 f ∧ u ∈ 𝒱 f ∧ v ≠ u"
apply (simp add: pre_subdivFace'_def before_def)
apply (elim conjE exE)
apply (subgoal_tac "distinct (verticesFrom f v')") apply force
apply (rule verticesFrom_distinct) by simp_all
moreover
from "help" pre_add nextVert have help1: "is_nextElem (vertices f) v u ⟹ 0 < n" apply auto
apply (simp add: nextVertex_def)
by (simp add: nextElem_is_nextElem pre_subdivFace'_def)
moreover
have help2: "before (verticesFrom f v') v u ⟹ distinct (verticesFrom f v') ⟹ v ≠ v' ⟹ ¬ is_nextElem (verticesFrom f v') u v"
apply (simp add: before_def is_nextElem_def verticesFrom_hd is_sublist_def) apply safe
apply (frule dist_at)
apply simp
apply (thin_tac "verticesFrom f v' = a @ v # b @ u # c")
apply (subgoal_tac "verticesFrom f v' = (as @ [u]) @ v # bs") apply assumption
apply simp apply (subgoal_tac "distinct (a @ v # b @ u # c)") apply force by simp
note pre_add f
moreover
from pre_add f help2 help1 "help" have "[countVertices g..<countVertices g + n] = [] ⟹ (v, u) ∉ edges f ∧ (u, v) ∉ edges f"
apply (cases "0 < n") apply (induct g) apply simp+
apply (simp add: pre_subdivFace'_def)
apply (rule conjI) apply force
apply (simp split: if_split_asm)
apply (rule ccontr) apply simp
apply (subgoal_tac "v = v'") apply simp apply (elim conjE) apply (simp only:)
apply (rule verticesFrom_is_nextElem_last) apply force apply force
apply (simp add: verticesFrom_is_nextElem [symmetric])
apply (cases "v = v'") apply simp
apply (subgoal_tac "v' ∈ 𝒱 f")
apply (thin_tac "u ∈ 𝒱 f")
apply (simp add: verticesFrom_is_nextElem)
apply (rule ccontr) apply simp
apply (subgoal_tac "v' ∈ 𝒱 f")
apply (drule verticesFrom_is_nextElem_hd) apply simp+
apply (elim conjE) apply (drule help2)
apply simp apply simp
apply (subgoal_tac "is_nextElem (vertices f) u v = is_nextElem (verticesFrom f v') u v")
apply simp
apply (rule verticesFrom_is_nextElem) by simp
ultimately
show ?thesis
apply (simp add: pre_subdivFace'_def)
apply (unfold pre_splitFace_def)
apply simp
apply (cases "0 < n") apply (induct g) apply (simp add: ivl_disj_int)
apply (auto simp: invalidVertexList_def is_duplicateEdge_def)
done
qed
lemma pre_subdivFace'_Some1:
"pre_subdivFace' g f v' v n ((Some u) # vol)
⟹ f ∈ ℱ g ⟹ (f ∙ v = u ⟶ n ≠ 0) ⟹ 𝒱 f ⊆ 𝒱 g
⟹ f21 = fst (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
⟹ g' = snd (snd (splitFace g v u f [countVertices g ..< countVertices g + n]))
⟹ pre_subdivFace' g' f21 v' u 0 vol"
apply (subgoal_tac "pre_splitFace g v u f [countVertices g ..< countVertices g + n]")
apply (rule pre_subdivFace'_Some1') apply assumption+
apply (simp)
apply (rule pre_subdivFace'_preFaceDiv)
by auto
end
Theory Invariants
section‹Invariants of (Plane) Graphs›
theory Invariants
imports FaceDivisionProps
begin
subsection‹Rotation of face into normal form›
definition minVertex :: "face ⇒ vertex" where
"minVertex f ≡ min_list (vertices f)"
definition normFace :: "face ⇒ vertex list" where
"normFace ≡ λf. verticesFrom f (minVertex f)"
definition normFaces :: "face list ⇒ vertex list list" where
"normFaces fl ≡ map normFace fl"
lemma normFaces_distinct: "distinct (normFaces fl) ⟹ distinct fl"
apply (induct fl) by (auto simp: normFace_def normFaces_def)
subsection ‹Minimal (plane) graph properties›
definition minGraphProps' :: "graph ⇒ bool" where
"minGraphProps' g ≡ ∀f ∈ ℱ g. 2 < |vertices f| ∧ distinct (vertices f)"
definition edges_sym :: "graph ⇒ bool" where
"edges_sym g ≡ ∀ a b. (a,b) ∈ edges g ⟶ (b,a) ∈ edges g"
definition faceListAt_len :: "graph ⇒ bool" where
"faceListAt_len g ≡ (length (faceListAt g) = countVertices g)"
definition facesAt_eq :: "graph ⇒ bool" where
"facesAt_eq g ≡ ∀v ∈ 𝒱 g. set(facesAt g v) = {f. f ∈ ℱ g ∧ v ∈ 𝒱 f}"
definition facesAt_distinct :: "graph ⇒ bool" where
"facesAt_distinct g ≡ ∀v ∈ 𝒱 g. distinct (normFaces (facesAt g v))"
definition faces_distinct :: "graph ⇒ bool" where
"faces_distinct g ≡ distinct (normFaces (faces g))"
definition faces_subset :: "graph ⇒ bool" where
"faces_subset g ≡ ∀f ∈ ℱ g. 𝒱 f ⊆ 𝒱 g"
definition edges_disj :: "graph ⇒ bool" where
"edges_disj g ≡
∀f ∈ ℱ g. ∀f' ∈ ℱ g. f ≠ f' ⟶ ℰ f ∩ ℰ f' = {}"
definition face_face_op :: "graph ⇒ bool" where
"face_face_op g ≡ |faces g| ≠ 2 ⟶
(∀f∈ℱ g. ∀f'∈ℱ g. f ≠ f' ⟶ ℰ f ≠ (ℰ f')¯)"
definition one_final_but :: "graph ⇒ (vertex × vertex)set ⇒ bool" where
"one_final_but g E ≡
∀f ∈ ℱ g. ¬ final f ⟶
(∀(a,b)∈ℰ f - E. (b,a) : E ∨ (∃f'∈ℱ g. final f' ∧ (b,a) ∈ ℰ f'))"
definition one_final :: "graph ⇒ bool" where
"one_final g ≡ one_final_but g {}"
definition minGraphProps :: "graph ⇒ bool" where
"minGraphProps g ≡ minGraphProps' g ∧ facesAt_eq g ∧ faceListAt_len g ∧ facesAt_distinct g ∧ faces_distinct g ∧ faces_subset g ∧ edges_sym g ∧ edges_disj g ∧ face_face_op g"
definition inv :: "graph ⇒ bool" where
"inv g ≡ minGraphProps g ∧ one_final g ∧ |faces g| ≥ 2"
lemma facesAt_distinctI:
"(⋀v. v ∈ 𝒱 g ⟹ distinct (normFaces (facesAt g v))) ⟹ facesAt_distinct g"
by (simp add: facesAt_distinct_def)
lemma minGraphProps2:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ 2 < |vertices f|"
by (unfold minGraphProps_def minGraphProps'_def) auto
lemma mgp_vertices3:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ |vertices f| ≥ 3"
by(auto dest:minGraphProps2)
lemma mgp_vertices_nonempty:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ vertices f ≠ []"
by(auto dest:minGraphProps2)
lemma minGraphProps3:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ distinct (vertices f)"
by (unfold minGraphProps_def minGraphProps'_def) auto
lemma minGraphProps4:
"minGraphProps g ⟹ (length (faceListAt g) = countVertices g)"
by (unfold minGraphProps_def faceListAt_len_def) simp
lemma minGraphProps5:
"⟦minGraphProps g; v : 𝒱 g; f ∈ set (facesAt g v)⟧ ⟹ f ∈ ℱ g"
by(auto simp: facesAt_def facesAt_eq_def minGraphProps_def minGraphProps'_def
faceListAt_len_def split:if_split_asm)
lemma minGraphProps6:
"minGraphProps g ⟹ v : 𝒱 g ⟹ f ∈ set (facesAt g v) ⟹ v ∈ 𝒱 f"
by(auto simp: facesAt_def facesAt_eq_def minGraphProps_def minGraphProps'_def
faceListAt_len_def split:if_split_asm)
lemma minGraphProps9:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ v ∈ 𝒱 f ⟹ v ∈ 𝒱 g"
by (unfold minGraphProps_def faces_subset_def) auto
lemma minGraphProps7:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ v ∈ 𝒱 f ⟹ f ∈ set (facesAt g v)"
apply(frule (2) minGraphProps9)
by (unfold minGraphProps_def facesAt_eq_def) simp
lemma minGraphProps_facesAt_eq: "minGraphProps g ⟹
v ∈ 𝒱 g ⟹ set (facesAt g v) = {f ∈ ℱ g. v ∈ 𝒱 f}"
by (simp add: minGraphProps_def facesAt_eq_def)
lemma mgp_dist_facesAt[simp]:
"minGraphProps g ⟹ v : 𝒱 g ⟹ distinct (facesAt g v)"
by(auto simp: facesAt_def minGraphProps_def minGraphProps'_def facesAt_distinct_def dest:normFaces_distinct)
lemma minGraphProps8:
"minGraphProps g ⟹ v : 𝒱 g ⟹ distinct (normFaces (facesAt g v))"
by(auto simp: facesAt_def minGraphProps_def minGraphProps'_def facesAt_distinct_def normFaces_def)
lemma minGraphProps8a:
"minGraphProps g ⟹ v ∈ 𝒱 g ⟹ distinct (normFaces (faceListAt g ! v))"
apply (frule (1) minGraphProps8[where v=v]) by (simp add: facesAt_def)
lemma minGraphProps8a': "minGraphProps g ⟹
v < countVertices g ⟹ distinct (normFaces (faceListAt g ! v))"
by (simp add: minGraphProps8a vertices_graph)
lemma minGraphProps9':
"minGraphProps g ⟹ f ∈ ℱ g ⟹ v ∈ 𝒱 f ⟹ v < countVertices g"
by (simp add: minGraphProps9 in_vertices_graph[symmetric])
lemma minGraphProps10:
"minGraphProps g ⟹ (a, b) ∈ edges g ⟹ (b, a) ∈ edges g"
apply (unfold minGraphProps_def edges_sym_def)
apply (elim conjE allE impE)
by simp+
lemma minGraphProps11:
"minGraphProps g ⟹ distinct (normFaces (faces g))"
by (unfold minGraphProps_def faces_distinct_def) simp
lemma minGraphProps11':
"minGraphProps g ⟹ distinct (faces g)"
by(simp add: minGraphProps11 normFaces_distinct)
lemma minGraphProps12:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ (a,b) ∈ ℰ f ⟹ (b,a) ∉ ℰ f"
apply (subgoal_tac "distinct (vertices f)") apply (simp add: is_nextElem_def)
apply (case_tac "vertices f = []")
apply (drule minGraphProps2)
apply simp
apply simp
apply simp
apply (case_tac "a = last (vertices f) ∧ b = hd (vertices f)")
apply (case_tac "vertices f") apply simp
apply (case_tac "list" rule: rev_exhaust)
apply (drule minGraphProps2) apply simp
apply simp
apply (case_tac "ys")
apply (drule minGraphProps2) apply simp apply simp
apply (simp del: distinct_append distinct.simps)
apply (rule conjI)
apply (rule ccontr) apply (simp del: distinct_append distinct.simps)
apply (drule is_sublist_distinct_prefix) apply simp
apply (simp add: is_prefix_def)
apply simp
apply (rule conjI)
apply (simp add: is_sublist_def) apply (elim exE) apply (intro allI) apply (rule ccontr)
apply (simp del: distinct_append distinct.simps)
apply (subgoal_tac "asa = as @ [a]") apply simp
apply (rule dist_at1) apply assumption apply force apply (rule sym) apply simp
apply (subgoal_tac "is_sublist [a, b] (vertices f)")
apply (rule impI) apply (rule ccontr)
apply (simp add: is_sublist_def del: distinct_append distinct.simps)
apply (subgoal_tac "last (vertices f) = b ∧ hd (vertices f) = a")
apply (thin_tac "a = hd (vertices f)") apply (thin_tac "b = last (vertices f)") apply (elim conjE)
apply (elim exE)
apply (case_tac "as")
apply (case_tac "bs" rule: rev_exhaust) apply (drule minGraphProps2) apply simp apply simp
apply simp+
apply (rule minGraphProps3) by simp+
lemma minGraphProps7': "minGraphProps g ⟹
f ∈ ℱ g ⟹ v ∈ 𝒱 f ⟹ f ∈ set (faceListAt g ! v)"
apply (frule minGraphProps7) apply assumption+
by (simp add: facesAt_def split: if_split_asm)
lemma mgp_edges_disj:
"⟦ minGraphProps g; f ≠ f'; f ∈ ℱ g; f' ∈ ℱ g ⟧ ⟹
uv ∈ ℰ f ⟹ uv ∉ ℰ f'"
by (simp add:minGraphProps_def edges_disj_def) blast
lemma one_final_but_antimono:
"one_final_but g E ⟹ E ⊆ E' ⟹ one_final_but g E'"
apply(unfold one_final_but_def)
apply blast
done
lemma one_final_antimono: "one_final g ⟹ one_final_but g E"
apply(unfold one_final_def one_final_but_def)
apply blast
done
lemma inv_two_faces: "inv g ⟹ |faces g| ≥ 2"
by(simp add:inv_def)
lemma inv_mgp[simp]: "inv g ⟹ minGraphProps g"
by(simp add:inv_def)
lemma makeFaceFinal_id[simp]: "final f ⟹ makeFaceFinal f g = g"
apply(cases g)
apply (simp add:makeFaceFinal_def makeFaceFinalFaceList_def
setFinal_eq_iff[THEN iffD2])
done
lemma inv_one_finalD':
"⟦ inv g; f ∈ ℱ g; ¬ final f; (a,b) ∈ ℰ f ⟧ ⟹
∃f' ∈ ℱ g. final f' ∧ f' ≠ f ∧ (b,a) ∈ ℰ f'"
apply(unfold inv_def one_final_def one_final_but_def)
apply blast
done
lemmas minGraphProps =
minGraphProps2 minGraphProps3 minGraphProps4
minGraphProps5 minGraphProps6 minGraphProps7 minGraphProps8
minGraphProps9
lemma mgp_no_loop[simp]:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ v ∈ 𝒱 f ⟹ f ∙ v ≠ v"
apply(frule (1) mgp_vertices3)
apply(frule (1) minGraphProps3)
apply(simp add: distinct_no_loop1)
done
lemma mgp_facesAt_no_loop:
"minGraphProps g ⟹ v : 𝒱 g ⟹ f ∈ set (facesAt g v) ⟹ f ∙ v ≠ v"
by(blast dest:mgp_no_loop minGraphProps5 minGraphProps6)
lemma edge_pres_faceAt:
"⟦ minGraphProps g; u : 𝒱 g; f ∈ set(facesAt g u); (u,v) ∈ ℰ f ⟧ ⟹
f ∈ set(facesAt g v)"
apply(auto simp:edges_face_eq)
apply(rule minGraphProps7, assumption)
apply(blast intro:minGraphProps)
apply(simp)
done
lemma in_facesAt_nextVertex:
"minGraphProps g ⟹ v : 𝒱 g ⟹ f ∈ set(facesAt g v) ⟹ f ∈ set(facesAt g (f ∙ v))"
apply(subgoal_tac "(v,f ∙ v) ∈ ℰ f")
apply(blast intro:edge_pres_faceAt)
by(blast intro: nextVertex_in_edges minGraphProps)
lemma mgp_edge_face_ex:
assumes [intro]: "minGraphProps g" "v : 𝒱 g"
and fv: "f ∈ set(facesAt g v)" and uv: "(u,v) ∈ ℰ f"
shows "∃f' ∈ set(facesAt g v). (v,u) ∈ ℰ f'"
proof -
from fv have "f ∈ ℱ g" by(blast intro:minGraphProps)
with uv have "(u,v) ∈ ℰ g" by(auto simp:edges_graph_def)
hence "(v,u) ∈ ℰ g" by(blast intro:minGraphProps10)
then obtain f' where f': "f' ∈ ℱ g" and vu: "(v,u) ∈ ℰ f'"
by(auto simp:edges_graph_def)
from vu have "v ∈ 𝒱 f'" by(auto simp:edges_face_eq)
with f' have "f' ∈ set(facesAt g v)" by(blast intro:minGraphProps)
with vu show ?thesis by blast
qed
lemma nextVertex_in_graph:
"minGraphProps g ⟹ v : 𝒱 g ⟹ f ∈ set(facesAt g v) ⟹ f ∙ v : 𝒱 g"
by(blast intro: minGraphProps9 minGraphProps5 minGraphProps6 nextVertex_in_face)
lemma mgp_nextVertex_face_ex2:
assumes mgp[intro]: "minGraphProps g" "v : 𝒱 g" and f: "f ∈ set(facesAt g v)"
shows "∃f' ∈ set(facesAt g (f ∙ v)). f' ∙ (f ∙ v) = v"
proof -
from f have "(v,f ∙ v) ∈ ℰ f"
by(blast intro: nextVertex_in_edges minGraphProps)
with in_facesAt_nextVertex[OF mgp f]
mgp_edge_face_ex[OF mgp(1) nextVertex_in_graph[OF mgp f]]
obtain f' :: face where "f' ∈ set(facesAt g (f ∙ v))"
and "(f ∙ v,v) ∈ ℰ f'"
by(blast)
thus ?thesis by (auto simp: edges_face_eq)
qed
lemma inv_finals_nonempty: "inv g ⟹ finals g ≠ []"
apply(frule inv_two_faces)
apply(clarsimp simp:filter_empty_conv finals_def)
apply(subgoal_tac "faces g ≠ []")
prefer 2 apply clarsimp
apply(simp add:neq_Nil_conv)
apply clarify
apply(rename_tac f fs)
apply(case_tac "final f")
apply simp
apply(frule mgp_vertices_nonempty[OF inv_mgp])
apply fastforce
apply(clarsimp simp:neq_Nil_conv)
apply(rename_tac v vs)
apply(subgoal_tac "v ∈ 𝒱 f")
prefer 2 apply simp
apply(drule nextVertex_in_edges)
apply(drule inv_one_finalD')
prefer 2 apply assumption
apply simp
apply assumption
apply(auto)
done
subsection ‹@{const containsDuplicateEdge}›
definition
containsUnacceptableEdgeSnd' :: "(nat ⇒ nat ⇒ bool) ⇒ nat list ⇒ bool" where
"containsUnacceptableEdgeSnd' N is ≡
(∃k < |is| - 2. let i0 = is!k; i1 = is!(k+1); i2 = is!(k+2) in
N i1 i2 ∧ (i0 < i1) ∧ (i1 < i2))"
lemma containsUnacceptableEdgeSnd_eq:
"containsUnacceptableEdgeSnd N v is = containsUnacceptableEdgeSnd' N (v#is)"
proof (induct "is" arbitrary: v)
case Nil then show ?case by (simp add: containsUnacceptableEdgeSnd'_def)
next
case (Cons i "is") then show ?case
proof (rule_tac iffI)
assume vors: "containsUnacceptableEdgeSnd N v (i # is)"
then show "containsUnacceptableEdgeSnd' N (v # i # is)"
apply (cases "is") apply simp apply simp
apply (simp split: if_split_asm del: containsUnacceptableEdgeSnd.simps)
apply (simp add: containsUnacceptableEdgeSnd'_def) apply force
apply (subgoal_tac "a # list = is") apply (thin_tac "is = a # list") apply (simp add: Cons)
apply (simp add: containsUnacceptableEdgeSnd'_def) apply (elim exE)
apply (rule exI) apply (subgoal_tac "Suc k < |is|") apply (rule conjI) apply assumption by auto
next
assume vors: "containsUnacceptableEdgeSnd' N (v # i # is)"
then show "containsUnacceptableEdgeSnd N v (i # is)"
apply simp apply (cases "is") apply (simp add: containsUnacceptableEdgeSnd'_def)
apply (simp del: containsUnacceptableEdgeSnd.simps)
apply (subgoal_tac "a # list = is") apply (thin_tac "is = a # list")
apply (simp add: Cons)
apply (subgoal_tac "is = a # list") apply (thin_tac "a # list = is")
apply (simp add: containsUnacceptableEdgeSnd'_def)
apply (elim exE) apply (case_tac "k") apply simp apply simp apply (intro impI exI)
apply (rule conjI) apply (elim conjE) apply assumption by auto
qed
qed
lemma containsDuplicateEdge_eq1:
"containsDuplicateEdge g f v is = containsDuplicateEdge' g f v is"
apply (simp add: containsDuplicateEdge_def)
apply (cases "is") apply (simp add: containsDuplicateEdge'_def)
apply simp
apply (case_tac "list") apply (simp add: containsDuplicateEdge'_def)
apply (simp add: containsUnacceptableEdgeSnd_eq del: containsUnacceptableEdgeSnd.simps)
apply (rule conjI) apply (simp add: containsDuplicateEdge'_def)
apply (rule impI)
apply (case_tac "a < aa")
by (simp_all add: containsDuplicateEdge'_def containsUnacceptableEdgeSnd'_def)
lemma containsDuplicateEdge_eq:
"containsDuplicateEdge = containsDuplicateEdge'"
apply (rule ext)+
by (simp add: containsDuplicateEdge_eq1)
declare Nat.diff_is_0_eq' [simp del]
subsection‹@{const replacefacesAt}›
primrec replacefacesAt2 ::
"nat list ⇒ face ⇒ face list ⇒ face list list ⇒ face list list" where
"replacefacesAt2 [] f fs F = F" |
"replacefacesAt2 (n#ns) f fs F =
(if n < |F|
then replacefacesAt2 ns f fs (F [n:=replace f fs (F!n)])
else replacefacesAt2 ns f fs F)"
lemma replacefacesAt_eq[THEN eq_reflection]:
"replacefacesAt ns oldf newfs F = replacefacesAt2 ns oldf newfs F"
by (induct ns arbitrary: F) (auto simp add: replacefacesAt_def)
lemma replacefacesAt2_notin:
"i ∉ set is ⟹ (replacefacesAt2 is olfF newFs Fss)!i = Fss!i"
proof (induct "is" arbitrary: Fss)
case Nil then show ?case by (simp)
next
case (Cons j js) then show ?case
by (cases "j < |Fss|") (auto)
qed
lemma replacefacesAt2_in:
"i ∈ set is ⟹ distinct is ⟹ i < |Fss| ⟹
(replacefacesAt2 is olfF newFs Fss)!i = replace olfF newFs (Fss !i)"
proof (induct "is" arbitrary: Fss)
case Nil then show ?case by simp
next
case (Cons j js)
then have "j = i ∧ i ∉ set js ∨ i ≠ j ∧ i ∈ set js" by auto
then show ?case
proof (elim disjE conjE)
assume "j = i" "i ∉ set js" with Cons show ?thesis
by (auto simp add: replacefacesAt2_notin)
next
assume "i ∈ set js" "i ≠ j" with Cons show ?thesis by simp
qed
qed
lemma distinct_replacefacesAt21:
"i < |Fss| ⟹ i ∈ set is ⟹ distinct is ⟹ distinct (Fss!i) ⟹ distinct newFs ⟹
set (Fss ! i) ∩ set newFs ⊆ {olfF} ⟹
distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
proof (induct "is")
case Nil then show ?case by simp
next
case (Cons j js)
then have "j = i ∧ i ∉ set js ∨ i ≠ j ∧ i ∈ set js" by auto
then show ?case
proof (elim disjE conjE)
assume "j = i" "i ∉ set js" with Cons show ?thesis
by (simp add: replacefacesAt2_notin distinct_replace)
next
assume "i ∈ set js" "i ≠ j" with Cons show ?thesis
by (simp add: replacefacesAt2_in distinct_replace)
qed
qed
lemma distinct_replacefacesAt22:
"i < |Fss| ⟹ i ∉ set is ⟹ distinct is ⟹ distinct (Fss!i) ⟹ distinct newFs ⟹
set (Fss ! i) ∩ set newFs ⊆ {olfF} ⟹
distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
proof (induct "is")
case Nil then show ?case by simp
next
case (Cons j js)
then have "i ≠ j" by auto
with Cons show ?case
by (simp add: replacefacesAt2_notin distinct_replace)
qed
lemma distinct_replacefacesAt2_2:
"i < |Fss| ⟹ distinct is ⟹ distinct (Fss!i) ⟹ distinct newFs ⟹
set (Fss ! i) ∩ set newFs ⊆ {olfF} ⟹
distinct ((replacefacesAt2 is olfF newFs Fss)! i)"
by (cases "i ∈ set is")
(auto intro: distinct_replacefacesAt21 distinct_replacefacesAt22)
lemma replacefacesAt2_nth1:
"k ∉ set ns ⟹ (replacefacesAt2 ns oldf newfs F) ! k = F ! k"
by (induct ns arbitrary: F) auto
lemma replacefacesAt2_nth1': "k ∈ set ns ⟹ k < |F| ⟹ distinct ns ⟹
(replacefacesAt2 ns oldf newfs F) ! k = (replace oldf newfs (F!k))"
apply (induct ns arbitrary: F)
apply auto
apply (simp add: replacefacesAt2_nth1)+
by (case_tac "a = k") auto
lemma replacefacesAt2_nth2: "k < |F| ⟹
(replacefacesAt2 [k] oldf newfs F) ! k = replace oldf newfs (F!k)"
by (auto)
lemma replacefacesAt2_length[simp]:
"|replacefacesAt2 nvs f' f'' vs| = |vs|"
by (induct nvs arbitrary: vs) simp_all
lemma replacefacesAt2_nth: "k ∈ set ns ⟹ k < |F| ⟹ oldf ∉ set newfs ⟹
distinct (F!k) ⟹ distinct newfs ⟹ oldf ∈ set (F!k) ⟶ set newfs ∩ set (F!k) ⊆ {oldf} ⟹
(replacefacesAt2 ns oldf newfs F) ! k = (replace oldf newfs (F!k))"
proof (induct ns arbitrary: F)
case Nil then show ?case by simp
next
case (Cons n ns) then show ?case
apply (simp only: replacefacesAt2.simps)
apply simp apply (case_tac "n = k")
apply (simp)
apply (subgoal_tac "replacefacesAt2 ns oldf newfs (F[k := replace oldf newfs (F ! k)]) ! k =
replace oldf newfs ((F[k := replace oldf newfs (F ! k)]) ! k)")
apply simp
apply (case_tac "k ∈ set ns") apply (rule Cons) apply simp+
apply (rule replace_distinct) apply simp apply simp
apply simp
apply simp
apply (simp add:distinct_set_replace)
apply (simp add: replacefacesAt2_nth1)
by simp
qed
lemma replacefacesAt_notin:
"i ∉ set is ⟹ (replacefacesAt is olfF newFs Fss)!i = Fss!i"
by (simp add: replacefacesAt_eq replacefacesAt2_notin)
lemma replacefacesAt_in:
"i ∈ set is ⟹ distinct is ⟹ i < |Fss| ⟹
(replacefacesAt is olfF newFs Fss)!i = replace olfF newFs (Fss !i)"
by (simp add: replacefacesAt_eq replacefacesAt2_in)
lemma replacefacesAt_length[simp]: "|replacefacesAt nvs f' [f''] vs| = |vs|"
by (simp add: replacefacesAt_eq)
lemma replacefacesAt_nth2: "k < |F| ⟹
(replacefacesAt [k] oldf newfs F) ! k = replace oldf newfs (F!k)"
by (simp add: replacefacesAt_eq replacefacesAt2_nth2)
lemma replacefacesAt_nth: "k ∈ set ns ⟹ k < |F| ⟹ oldf ∉ set newfs ⟹
distinct (F!k) ⟹ distinct newfs ⟹ oldf ∈ set (F!k) ⟶ set newfs ∩ set (F!k) ⊆ {oldf} ⟹
(replacefacesAt ns oldf newfs F) ! k = (replace oldf newfs (F!k))"
by (simp add: replacefacesAt_eq replacefacesAt2_nth)
lemma replacefacesAt2_5: "x ∈ set (replacefacesAt2 ns oldf newfs F ! k) ⟹ x ∈ set (F!k) ∨ x ∈ set newfs"
proof (induct ns arbitrary: F)
case Nil then show ?case by simp
next
case (Cons n ns)
then show ?case
apply(simp add: split: if_split_asm ) apply (frule Cons)
apply (thin_tac "⋀F. x ∈ set (replacefacesAt2 ns oldf newfs F ! k) ⟹ x ∈ set (F ! k) ∨ x ∈ set newfs")
apply (case_tac "x ∈ set newfs") apply simp apply simp
apply (case_tac "k = n") apply simp apply (frule replace5) apply simp by simp
qed
lemma replacefacesAt_Nil[simp]: "replacefacesAt [] f fs F = F"
by (simp add: replacefacesAt_eq)
lemma replacefacesAt_Cons[simp]:
"replacefacesAt (n # ns) f fs F =
(if n < |F| then replacefacesAt ns f fs (F[n := replace f fs (F!n)])
else replacefacesAt ns f fs F)"
by (simp add: replacefacesAt_eq)
lemmas replacefacesAt_simps = replacefacesAt_Nil replacefacesAt_Cons
lemma len_nth_repAt[simp]:
"⋀xs. i < |xs| ⟹ |replacefacesAt is x [y] xs ! i| = |xs!i|"
by (induct "is") (simp_all add: add:nth_list_update)
subsection‹@{const normFace}›
lemma minVertex_in: "vertices f ≠ [] ⟹ minVertex f ∈ 𝒱 f"
by (simp add: minVertex_def)
lemma minVertex_eq_if_vertices_eq:
"𝒱 f = 𝒱 f' ⟹ minVertex f = minVertex f'"
apply(cases f)
apply(cases f')
apply(rename_tac vs ft vs' ft')
apply(case_tac "vs = []")
apply(simp add:vertices_face_def minVertex_def)
apply(subgoal_tac "vs' ≠ []")
prefer 2 apply clarsimp
apply(simp add:vertices_face_def minVertex_def min_list_conv_Min
insert_absorb del:Min_insert)
done
lemma normFace_replace_in:
"normFace a ∈ set (normFaces (replace oldF newFs fs)) ⟹
normFace a ∈ set (normFaces newFs) ∨ normFace a ∈ set (normFaces fs)"
apply (induct fs) apply simp
apply (auto simp add: normFaces_def split:if_split_asm)
done
lemma distinct_replace_norm:
"distinct (normFaces fs) ⟹ distinct (normFaces newFs) ⟹
set (normFaces fs) ∩ set (normFaces newFs) ⊆ {} ⟹ distinct (normFaces (replace oldF newFs fs))"
apply (induct fs) apply simp
apply simp
apply (case_tac "a = oldF") apply (simp add: normFaces_def) apply blast
apply (simp add: normFaces_def) apply (rule ccontr)
apply (subgoal_tac "normFace a ∈ set(normFaces (replace oldF newFs fs))")
apply (frule normFace_replace_in)
by (simp add: normFaces_def)+
lemma distinct_replacefacesAt1_norm:
"i < |Fss| ⟹ i ∈ set is ⟹ distinct is ⟹ distinct (normFaces (Fss!i)) ⟹ distinct (normFaces newFs) ⟹
set (normFaces (Fss ! i)) ∩ set (normFaces newFs) ⊆ {} ⟹
distinct (normFaces ((replacefacesAt is oldF newFs Fss)! i))"
proof (induct "is")
case Nil then show ?case by simp
next
case (Cons j js)
then have "j = i ∧ i ∉ set js ∨ i ≠ j ∧ i ∈ set js" by auto
then show ?case
proof (elim disjE conjE)
assume "j = i" "i ∉ set js" with Cons show ?thesis
by (simp add: replacefacesAt_notin distinct_replace_norm)
next
assume "i ∈ set js" "i ≠ j" with Cons show ?thesis
by (simp add: replacefacesAt_in distinct_replace_norm)
qed
qed
lemma distinct_replacefacesAt2_norm:
"i < |Fss| ⟹ i ∉ set is ⟹ distinct is ⟹ distinct (normFaces (Fss!i)) ⟹ distinct (normFaces newFs) ⟹
set (normFaces (Fss ! i)) ∩ set (normFaces newFs) ⊆ {} ⟹
distinct (normFaces ((replacefacesAt is oldF newFs Fss)! i))"
proof (induct "is")
case Nil then show ?case by simp
next
case (Cons j js)
then have "i ≠ j" by auto
with Cons show ?case
by (simp add: replacefacesAt_notin distinct_replace_norm)
qed
lemma distinct_replacefacesAt_norm:
"i < |Fss| ⟹ distinct is ⟹ distinct (normFaces (Fss!i)) ⟹ distinct (normFaces newFs) ⟹
set (normFaces (Fss ! i)) ∩ set (normFaces newFs) ⊆ {} ⟹
distinct (normFaces ((replacefacesAt is olfF newFs Fss)! i))"
by (cases "i ∈ set is")
(auto intro: distinct_replacefacesAt1_norm distinct_replacefacesAt2_norm)
lemma normFace_in_cong:
"vertices f ≠ [] ⟹ minGraphProps g ⟹ normFace f ∈ set (normFaces (faces g))
⟹ ∃ f' ∈ set (faces g). f ≅ f'"
apply (simp add: normFace_def normFaces_def)
apply (erule imageE)
apply(rename_tac f')
apply (rule bexI)
defer apply assumption
apply (simp add: cong_face_def)
apply (rule congs_trans) apply (rule verticesFrom_congs)
apply (rule minVertex_in) apply simp
apply (rule congs_sym) apply (simp add: normFace_def)
apply (rule verticesFrom_congs) apply (rule minVertex_in)
apply (subgoal_tac "2 < | vertices f'|") apply force
by (simp add: minGraphProps2)
lemma normFace_neq:
"a ∈ 𝒱 f ⟹ a ∉ 𝒱 f' ⟹ vertices f' ≠ [] ⟹ normFace f ≠ normFace f'"
apply (simp add: normFace_def)
apply (subgoal_tac "a ∈ set (verticesFrom f (minVertex f))")
apply (subgoal_tac "a ∉ set (verticesFrom f' (minVertex f'))") apply force
apply (subgoal_tac "(vertices f') ≅ (verticesFrom f' (minVertex f'))") apply (simp add: congs_pres_nodes)
apply (rule verticesFrom_congs) apply (rule minVertex_in) apply simp
apply (subgoal_tac "(vertices f) ≅ (verticesFrom f (minVertex f))") apply (simp add: congs_pres_nodes)
apply (rule verticesFrom_congs) apply (rule minVertex_in) by auto
lemma split_face_f12_f21_neq_norm:
"pre_split_face oldF ram1 ram2 vs ⟹
2 < |vertices oldF| ⟹ 2 < |vertices f12| ⟹ 2 < |vertices f21| ⟹
(f12, f21) = split_face oldF ram1 ram2 vs ⟹ normFace f12 ≠ normFace f21"
proof -
assume split: "(f12, f21) = split_face oldF ram1 ram2 vs"
"pre_split_face oldF ram1 ram2 vs"
and minlen: "2 < |vertices oldF|" "2 < | vertices f12|" "2 < | vertices f21|"
from split have dist_f12: "distinct (vertices f12)" by (rule split_face_distinct1)
from split have dist_f21: "distinct (vertices f21)" by (rule split_face_distinct2)
from split dist_f12 dist_f21 minlen show ?thesis
apply (simp add: split_face_def)
apply (case_tac "between (vertices oldF) ram2 ram1")
apply (case_tac "between (vertices oldF) ram1 ram2")
apply simp apply (subgoal_tac "|vertices oldF| = 2")
apply simp apply (frule verticesFrom_ram1)
apply (subgoal_tac "distinct (vertices oldF)") apply (drule verticesFrom_length)
apply (subgoal_tac "ram1 ∈ 𝒱 oldF") apply assumption apply (simp add: pre_split_face_def) apply simp
apply (simp add: pre_split_face_def)
apply (rule normFace_neq)
apply (subgoal_tac "a ∈ 𝒱 (Face (rev vs @ ram1 # between (vertices oldF) ram1 ram2 @ [ram2]) Nonfinal)")
apply assumption apply simp apply force apply simp
apply (rule not_sym)
apply (rule normFace_neq)
apply (subgoal_tac "a ∈ 𝒱 (Face (ram2 # between (vertices oldF) ram2 ram1 @ ram1 # vs) Nonfinal)")
apply assumption apply simp
apply (frule verticesFrom_ram1)
apply (subgoal_tac "distinct (verticesFrom oldF ram1)") apply clarsimp
apply (rule verticesFrom_distinct)
by (simp add: pre_split_face_def)+
qed
lemma normFace_in: "f ∈ set fs ⟹ normFace f ∈ set (normFaces fs)"
by (simp add: normFaces_def)
subsection‹Invariants of @{const splitFace}›
lemma splitFace_holds_minGraphProps':
"pre_splitFace g' v a f' vs ⟹ minGraphProps' g' ⟹
minGraphProps' (snd (snd (splitFace g' v a f' vs)))"
apply (simp add: minGraphProps'_def)
apply safe
apply (simp add: splitFace_def split_def)
apply (case_tac "f ∈ ℱ g'") apply simp
apply safe
apply (simp add: split_face_def) apply safe apply simp apply (drule pre_FaceDiv_between1) apply simp
apply (frule_tac replace1)
apply simp_all
apply (simp add: split_face_def) apply safe apply simp
apply (drule pre_FaceDiv_between2) apply simp
apply (drule splitFace_split)
apply safe
apply simp
apply (subgoal_tac "pre_splitFace g' v a f' vs")
apply (drule splitFace_distinct2)+ apply simp+
apply (subgoal_tac "pre_splitFace g' v a f' vs")
apply (drule splitFace_distinct1)+
by simp+
lemma splitFace_holds_faceListAt_len:
"pre_splitFace g' v a f' vs ⟹ minGraphProps g' ⟹
faceListAt_len (snd (snd (splitFace g' v a f' vs)))"
by (simp add: minGraphProps_def faceListAt_len_def splitFace_def split_def)
lemma splitFace_new_f12:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "f12 ∉ ℱ g"
proof (cases newVs)
case Nil with pre have "(ram2, ram1) ∉ edges g"
by (unfold pre_splitFace_def) auto
moreover from Nil pre
have "(ram2, ram1) ∈ edges f12"
apply (rule_tac splitFace_empty_ram2_ram1_in_f12)
apply (auto simp: Nil[symmetric])
apply (rule spl)
done
ultimately show ?thesis by (auto simp add: edges_graph_def)
next
case (Cons v vs)
with pre have "v ∉ 𝒱 g"
by (auto simp: pre_splitFace_def)
moreover from Cons spl have "v ∈ 𝒱 f12"
by (simp add: splitFace_f12_new_vertices)
moreover note props
ultimately show ?thesis by (auto dest: minGraphProps)
qed
lemma splitFace_new_f12_norm:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "normFace f12 ∉ set (normFaces (faces g))"
proof (cases newVs)
case Nil with pre have "(ram2, ram1) ∉ edges g"
by (auto simp: pre_splitFace_def)
moreover
from pre spl [symmetric] have dist_f12: "distinct (vertices f12)"
apply (drule_tac splitFace_distinct2) by simp
moreover
from Nil pre
have "(ram2, ram1) ∈ edges f12"
apply (rule_tac splitFace_empty_ram2_ram1_in_f12)
apply (auto simp: Nil[symmetric])
apply (rule spl)
done
moreover
with dist_f12 have "vertices f12 ≠ []"
apply (simp add: is_nextElem_def) apply (case_tac "vertices f12") apply (simp add: is_sublist_def)
by simp
ultimately show ?thesis
apply (auto simp add: edges_graph_def) apply (frule normFace_in_cong)
apply (rule props)
apply assumption
apply (elim bexE)
apply (subgoal_tac "(ram2, ram1) ∈ edges f'") apply simp
apply (subgoal_tac "(vertices f12) ≅ (vertices f')") apply (frule congs_distinct)
apply (simp add: cong_face_def is_nextElem_congs_eq)+
done
next
case (Cons v vs)
with pre have "v ∉ 𝒱 g" by (auto simp: pre_splitFace_def)
moreover from Cons spl have "v ∈ 𝒱 f12"
by (simp add: splitFace_f12_new_vertices)
moreover note props
ultimately show ?thesis
apply auto
apply (subgoal_tac "(vertices f12) ≠ []")
apply (frule normFace_in_cong) apply assumption+ apply (erule bexE)
apply (subgoal_tac "v ∈ 𝒱 f'") apply (simp add: minGraphProps9)
apply (simp add: congs_pres_nodes cong_face_def) by auto
qed
lemma splitFace_new_f21:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "f21 ∉ ℱ g"
proof (cases newVs)
case Nil with pre have "(ram1, ram2) ∉ edges g"
by (auto simp: pre_splitFace_def)
moreover from Nil pre
have "(ram1, ram2) ∈ edges f21"
apply (rule_tac splitFace_empty_ram1_ram2_in_f21)
apply (auto simp: Nil[symmetric])
apply (rule spl)
done
ultimately show ?thesis by (auto simp add: edges_graph_def)
next
case (Cons v vs)
with pre have "v ∉ 𝒱 g" by (auto simp: pre_splitFace_def)
moreover from Cons spl have "v ∈ 𝒱 f21"
by (simp add: splitFace_f21_new_vertices)
moreover note props
ultimately show ?thesis by (auto dest: minGraphProps)
qed
lemma splitFace_new_f21_norm:
assumes pre: "pre_splitFace g ram1 ram2 oldF newVs"
and props: "minGraphProps g"
and spl: "(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs"
shows "normFace f21 ∉ set (normFaces (faces g))"
proof (cases newVs)
case Nil with pre have "(ram1, ram2) ∉ edges g"
by (auto simp: pre_splitFace_def)
moreover
from pre spl [symmetric] have dist_f21: "distinct (vertices f21)"
apply (drule_tac splitFace_distinct1) by simp
moreover
from Nil pre
have "(ram1, ram2) ∈ edges f21"
apply (rule_tac splitFace_empty_ram1_ram2_in_f21)
apply (auto simp: Nil[symmetric])
apply (rule spl)
done
moreover
with dist_f21 have "vertices f21 ≠ []"
apply (simp add: is_nextElem_def) apply (case_tac "vertices f21") apply (simp add: is_sublist_def)
by simp
ultimately show ?thesis apply (auto simp add: edges_graph_def) apply (frule normFace_in_cong)
apply (rule props)
apply assumption
apply (elim bexE)
apply (subgoal_tac "(ram1, ram2) ∈ edges f'") apply simp
apply (subgoal_tac "(vertices f21) ≅ (vertices f')") apply (frule congs_distinct)
apply (simp add: cong_face_def is_nextElem_congs_eq)+
done
next
case (Cons v vs)
with pre have "v ∉ 𝒱 g" by (auto simp: pre_splitFace_def)
moreover from Cons spl have "v ∈ 𝒱 f21"
by (simp add: splitFace_f21_new_vertices)
moreover note props
ultimately show ?thesis apply auto
apply (subgoal_tac "(vertices f21) ≠ []")
apply (frule normFace_in_cong) apply assumption+ apply (erule bexE)
apply (subgoal_tac "v ∈ 𝒱 f'") apply (simp add: minGraphProps9)
apply (simp add: congs_pres_nodes cong_face_def) by auto
qed
lemma splitFace_f21_oldF_neq:
"pre_splitFace g ram1 ram2 oldF newVs ⟹
minGraphProps g ⟹
(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs ⟹
oldF ≠ f21"
by (frule splitFace_new_f21) (auto)
lemma splitFace_f12_oldF_neq:
"pre_splitFace g ram1 ram2 oldF newVs ⟹
minGraphProps g ⟹
(f12, f21, newGraph) = splitFace g ram1 ram2 oldF newVs ⟹
oldF ≠ f12"
by (frule splitFace_new_f12) (auto)
lemma splitFace_f12_f21_neq_norm:
"pre_splitFace g ram1 ram2 oldF vs ⟹ minGraphProps g ⟹
(f12, f21, newGraph) = splitFace g ram1 ram2 oldF vs ⟹
normFace f12 ≠ normFace f21"
apply (subgoal_tac "minGraphProps' newGraph")
apply (subgoal_tac "f12 ∈ ℱ newGraph ∧ f21 ∈ ℱ newGraph")
apply (subgoal_tac "pre_split_face oldF ram1 ram2 vs")
apply (frule split_face_f12_f21_neq_norm) apply (rule minGraphProps2) apply simp apply(erule pre_splitFace_oldF)
apply (subgoal_tac "2 < | vertices f12 |") apply assumption apply (force simp: minGraphProps'_def)
apply (subgoal_tac "2 < | vertices f21 |") apply assumption apply (force simp: minGraphProps'_def)
apply (simp add: splitFace_def split_def)
apply simp
apply force
apply (simp add: splitFace_def split_def)
apply (rule disjI2)
apply (erule replace3[OF pre_splitFace_oldF])
apply simp
apply (frule splitFace_holds_minGraphProps') apply (simp add: minGraphProps_def minGraphProps'_def)
by (simp add: splitFace_def split_def)
lemma set_faces_splitFace:
"⟦ minGraphProps g; f ∈ ℱ g; pre_splitFace g v1 v2 f vs;
(f1, f2, g') = splitFace g v1 v2 f vs ⟧
⟹ ℱ g' = {f1,f2} ∪ (ℱ g - {f})"
apply(frule minGraphProps11')
apply(blast dest:splitFace_new_f21 splitFace_new_f12
splitFace_faces_1 splitFace_delete_oldF)
done
declare minGraphProps8 minGraphProps8a minGraphProps8a' [intro]
lemma splitFace_holds_facesAt_distinct:
assumes pre: "pre_splitFace g v w f [countVertices g..<countVertices g + n]"
and mgp: "minGraphProps g"
shows "facesAt_distinct (snd (snd (splitFace g v w f [countVertices g..<countVertices g + n])))"
proof -
define ws where "ws = [countVertices g..<countVertices g + n]"
define f21 where "f21 = snd (split_face f v w ws)"
with pre ws_def have dist_f21: "distinct (vertices f21)" by (auto intro: split_face_distinct2)
define f12 where "f12 = fst (split_face f v w ws)"
with pre ws_def have dist_f12: "distinct (vertices f12)" by (auto intro: split_face_distinct1)
define vs1 where "vs1 = between (vertices f) v w"
define vs2 where "vs2 = between (vertices f) w v"
define g' where "g' = snd (snd (splitFace g v w f [countVertices g..<countVertices g + n]))"
from f12_def f21_def ws_def g'_def
have fdg: "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]"
by (simp add: splitFace_def split_def)
from pre mgp fdg have new_f12: "f12 ∉ ℱ g"
apply (rule_tac splitFace_new_f12) by simp_all
from pre mgp fdg have new_f21: "f21 ∉ ℱ g"
apply (rule_tac splitFace_new_f21) by simp_all
from pre mgp fdg have new_f12_norm: "normFace f12 ∉ set (normFaces (faces g))"
apply (rule_tac splitFace_new_f12_norm) by simp_all
from pre mgp fdg have new_f21_norm: "normFace f21 ∉ set (normFaces (faces g))"
apply (rule_tac splitFace_new_f21_norm) by simp_all
have "facesAt_distinct g'"
proof (rule facesAt_distinctI)
fix x assume x: "x ∈ 𝒱 g'"
show "distinct (normFaces (facesAt g' x))"
proof -
from mgp pre have a: "v < |faceListAt g|" "w < |faceListAt g|"
apply (unfold pre_splitFace_def)
apply (simp_all add: minGraphProps4)
by (auto intro: minGraphProps9')
then show ?thesis
proof (cases "x = w")
case True
moreover with pre have "v ≠ w"
by (unfold pre_splitFace_def) simp
moreover note a x pre mgp
ultimately show ?thesis
apply -
apply (unfold pre_splitFace_def)
apply (unfold g'_def splitFace_def facesAt_def)
apply (simp add: split_def nth_append)
apply (rule distinct_replace_norm)
apply (rule distinct_replacefacesAt_norm)
apply simp
apply (rule between_distinct)
apply simp
apply (rule distinct_replacefacesAt_norm)
apply assumption
apply (rule between_distinct)
apply simp
apply (rule minGraphProps8a') apply assumption+ apply (simp add: minGraphProps4)
apply (simp add: normFaces_def)
apply (subgoal_tac "set (faceListAt g ! w) = {f ∈ ℱ g. w ∈ 𝒱 f}") apply simp
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f12} = {}")
apply (simp add: f12_def ws_def normFaces_def) apply blast
apply (simp add: new_f12_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "w ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def split: if_split_asm)
apply (simp add: normFaces_def)
apply (subgoal_tac "w ∉ set (between (vertices f) v w)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "set (faceListAt g ! w) = {f ∈ ℱ g. w ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f21} = {}")
apply (simp add: f21_def ws_def normFaces_def) apply blast
apply (simp add: new_f21_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "w ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def minGraphProps4 vertices_graph)
apply (rule between_not_r2) apply simp
apply (simp add: normFaces_def) apply (rule splitFace_f12_f21_neq_norm)
apply (rule pre) apply simp
apply (subgoal_tac "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]")
apply (simp add: f12_def f21_def g'_def ws_def)
apply (rule fdg)
apply (subgoal_tac "w ∉ set (between (vertices f) w v)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "w ∉ set (between (vertices f) v w)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "set (faceListAt g ! w) = {f ∈ ℱ g. w ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f12,normFace f21} = {}")
apply (simp add: f12_def f21_def ws_def normFaces_def) apply blast
apply (simp add: new_f21_norm new_f12_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "w ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def minGraphProps4 vertices_graph)
apply (rule between_not_r2) apply simp
apply (rule between_not_r1) by simp
next
from pre have vw_neq: "v ≠ w"
by (unfold pre_splitFace_def) simp
case False then show ?thesis
proof (cases "x = v")
case True
with a x pre mgp vw_neq
show ?thesis
apply -
apply (unfold pre_splitFace_def)
apply (unfold g'_def splitFace_def facesAt_def)
apply (simp add: split_def nth_append)
apply (rule distinct_replace_norm)
apply (rule distinct_replacefacesAt_norm)
apply simp
apply (rule between_distinct)
apply simp
apply (rule distinct_replacefacesAt_norm)
apply assumption
apply (rule between_distinct)
apply simp
apply (rule minGraphProps8a) apply assumption+ apply (simp add: minGraphProps4 vertices_graph)
apply (simp add:normFaces_def)
apply (subgoal_tac "set (faceListAt g ! v) = {f ∈ ℱ g. v ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f12} = {}")
apply (simp add: f12_def ws_def normFaces_def) apply blast
apply (simp add: new_f12_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "v ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def split: if_split_asm)
apply (simp add: normFaces_def)
apply (subgoal_tac "v ∉ set (between (vertices f) v w)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "set (faceListAt g ! v) = {f ∈ ℱ g. v ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f21} = {}")
apply (simp add: f21_def ws_def normFaces_def) apply blast
apply (simp add: new_f21_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "v ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def split: if_split_asm)
apply (rule between_not_r1) apply simp
apply (simp add: normFaces_def) apply (rule not_sym)
apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp
apply (subgoal_tac "(f12, f21, g') = splitFace g v w f [countVertices g..<countVertices g + n]")
apply (simp add: f12_def f21_def ws_def g'_def) apply (rule fdg)
apply (subgoal_tac "v ∉ set (between (vertices f) w v)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "v ∉ set (between (vertices f) v w)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "set (faceListAt g ! v) = {f ∈ ℱ g. v ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f21,normFace f12} = {}")
apply (simp add: f12_def f21_def ws_def normFaces_def) apply blast
apply (simp add: new_f21_norm new_f12_norm)
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f21} = {}")
apply (simp add: new_f21_norm)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "v ∈ 𝒱 g") apply assumption
apply (rule minGraphProps9) apply assumption apply blast apply simp
apply (simp add: facesAt_def minGraphProps4 vertices_graph)
apply (simp add: new_f21_norm)
apply (rule between_not_r1) apply simp
apply (rule between_not_r2) by simp
next
assume xw_neq: "x ≠ w"
case False
with a x pre mgp vw_neq xw_neq
show ?thesis
apply -
apply (unfold pre_splitFace_def g'_def splitFace_def facesAt_def)
apply (simp add: split_def nth_append)
apply (case_tac "x < |faceListAt g|")
apply simp
apply (subgoal_tac "x ∈ 𝒱 g")
apply (rule distinct_replacefacesAt_norm)
apply simp
apply (rule between_distinct)
apply simp
apply (rule distinct_replacefacesAt_norm) apply assumption
apply (rule between_distinct)
apply simp
apply (rule minGraphProps8a) apply assumption apply (simp add: minGraphProps4)
apply (simp add: normFaces_def)
apply (subgoal_tac "set (faceListAt g ! x) = {f ∈ ℱ g. x ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f12} = {}")
apply (simp add: f12_def ws_def normFaces_def) apply blast
apply (simp add: new_f12_norm)
apply (frule minGraphProps_facesAt_eq) apply assumption
apply (simp add: facesAt_def split: if_split_asm)
apply (simp add: normFaces_def)
apply (case_tac "x ∉ set (between (vertices f) v w)")
apply (simp add: replacefacesAt_notin)
apply (subgoal_tac "set (faceListAt g ! x) = {f ∈ ℱ g. x ∈ 𝒱 f}")
apply (subgoal_tac "set (normFaces (faces g)) ∩ {normFace f21} = {}")
apply (simp add: f21_def ws_def normFaces_def) apply blast
apply (simp add: new_f21_norm)
apply (frule minGraphProps_facesAt_eq) apply assumption
apply (simp add: facesAt_def split: if_split_asm)
apply (simp add: normFaces_def)
apply (drule replacefacesAt_nth) apply assumption
apply (subgoal_tac "f ∉ set [fst (split_face f v w [countVertices g..<countVertices g + n])]")
apply assumption apply simp
apply (rule splitFace_f12_oldF_neq)
apply (subgoal_tac "pre_splitFace g v w f [countVertices g..<countVertices g + n]")
apply assumption apply (simp add: pre) apply assumption+
apply (simp add: splitFace_def split_def)
apply (rule normFaces_distinct)
apply (rule minGraphProps8a) apply assumption apply (simp add: minGraphProps4 vertices_graph)
apply (simp add: normFaces_def)
apply (rule impI) apply simp
apply (subgoal_tac "set (faceListAt g ! x) = {f ∈ ℱ g. x ∈ 𝒱 f}")
apply (subgoal_tac "ℱ g ∩ {f12} = {}")
apply (simp add: f12_def ws_def)
apply (simp add: new_f12)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "x ∈ 𝒱 g") apply assumption
apply (simp add: minGraphProps4 vertices_graph)
apply (simp add:facesAt_def minGraphProps4 vertices_graph)
apply (frule replacefacesAt_nth) apply assumption
apply (subgoal_tac "f ∉ set [fst (split_face f v w [countVertices g..<countVertices g + n])]")
apply assumption apply simp apply (rule splitFace_f12_oldF_neq)
apply (subgoal_tac "pre_splitFace g v w f [countVertices g..<countVertices g + n]") apply assumption
apply (simp add: pre) apply assumption apply (simp add: splitFace_def split_def)
apply (rule normFaces_distinct)
apply (rule minGraphProps8a') apply assumption apply (simp add: minGraphProps4)
apply simp
apply (rule impI) apply simp
apply (subgoal_tac "set (faceListAt g ! x) = {f ∈ ℱ g. x ∈ 𝒱 f}")
apply (subgoal_tac "ℱ g ∩ {f12} = {}")
apply (simp add: f12_def ws_def)
apply (simp add: new_f12)
apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "x ∈ 𝒱 g") apply assumption
apply (simp add: minGraphProps4 vertices_graph)
apply (simp add:facesAt_def minGraphProps4 vertices_graph)
apply (simp add: f12_def [symmetric] f21_def [symmetric] ws_def [symmetric])
apply (subgoal_tac "normFace f21 ∉ set (normFaces (replace f [f12] (faceListAt g ! x)))")
apply (simp add: normFaces_def)
apply (rule ccontr) apply simp
apply (frule normFace_replace_in)
apply (subgoal_tac "normFace f12 ≠ normFace f21")
apply (subgoal_tac "normFace f21 ∉ set (normFaces (faceListAt g ! x))")
apply (simp add: normFaces_def)
apply (rule ccontr) apply simp
apply (subgoal_tac "normFace f21 ∉ set (normFaces (facesAt g x))")
apply (simp add: facesAt_def)
apply (subgoal_tac "normFace f21 ∉ set (normFaces (faces g))") apply (frule minGraphProps_facesAt_eq)
apply (subgoal_tac "x ∈ 𝒱 g") apply assumption apply (simp add: minGraphProps4 vertices_graph)
apply (simp add: normFaces_def) apply (rule ccontr) apply simp
apply blast
apply (rule new_f21_norm)
apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp apply (rule fdg)
apply (simp add: minGraphProps4 vertices_graph)
apply (simp add: normFaces_def)
apply (subgoal_tac "(x - |faceListAt g | ) < n") apply simp
apply (rule splitFace_f12_f21_neq_norm) apply (rule pre) apply simp
apply (simp add: f12_def [symmetric] f21_def [symmetric] ws_def [symmetric]) apply (simp add: ws_def) apply (rule fdg)
by (simp add: minGraphProps4)
qed
qed
qed
qed
then show ?thesis by (simp add: g'_def)
qed
lemma splitFace_holds_facesAt_eq:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
and g'': "g'' = (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
shows "facesAt_eq g''"
proof -
have "[0..<countVertices g''] = [0..<countVertices g' + n]"
apply (simp add: g'') by (simp add: splitFace_def split_def)
hence vg'': "vertices g'' = [0..<countVertices g' + n]" by (simp add:vertices_graph)
define ws where "ws = [countVertices g'..<countVertices g' + n]"
define f21 where "f21 = snd (split_face f' v a ws)"
define f12 where "f12 = fst (split_face f' v a ws)"
define vs1 where "vs1 = between (vertices f') v a"
define vs2 where "vs2 = between (vertices f') a v"
from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g'' have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
by (simp add: splitFace_def split_def)
from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force
from pre_F' mgp fdg have f'_f21: "f' ≠ f21" apply (rule_tac splitFace_f21_oldF_neq) apply assumption by simp+
from pre_F' mgp fdg have f'_f12: "f' ≠ f12" apply (rule_tac splitFace_f12_oldF_neq) apply assumption by simp+
from f12_def vs1_def have vert_f12: "vertices f12 = rev ws @ v # vs1 @ [a]" by (simp add: split_face_def)
from f21_def vs2_def have vert_f21: "vertices f21 = a # vs2 @ v # ws" by (simp add: split_face_def)
from vs1_def vs2_def pre_F have vertFrom_f': "verticesFrom f' v =
v # vs1 @ a # vs2" apply simp
apply (rule_tac verticesFrom_ram1) by (rule pre_splitFace_pre_split_face)
from vs1_def vs2_def pre_F vertFrom_f' have vert_f': "𝒱 f' = set vs1 ∪ set vs2 ∪ {a,v}"
apply (subgoal_tac "(vertices f') ≅ (verticesFrom f' v)") apply (drule congs_pres_nodes)
apply (simp add: congs_pres_nodes) apply blast
apply (rule verticesFrom_congs) by (simp only: pre_splitFace_def)
from pre_F have dist_vertFrom_f': "distinct (verticesFrom f' v)" apply (rule_tac verticesFrom_distinct)
by (simp only: pre_splitFace_def)+
then have vs1_vs2_empty: "set vs1 ∩ set vs2 = {}" by (simp add: vertFrom_f')
from ws_def f21_def f12_def have "faces g'' = (replace f' [f21] (faces g')) @ [f12]"
apply (simp add: g'') by (simp add: splitFace_def split_def)
from mgp have dist_all: "⋀x. x ∈ 𝒱 g' ⟹ distinct (faceListAt g' ! x)"
apply (rule_tac normFaces_distinct)
by (simp add: minGraphProps_def facesAt_distinct_def facesAt_def)
from mgp have fla: "|faceListAt g'| = countVertices g'"
by (simp add: minGraphProps_def faceListAt_len_def)
from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric]
vs1_def [symmetric] vs2_def [symmetric] pre_F mgp vert_f'
show ?thesis
apply (simp add: g'')
apply (unfold splitFace_def facesAt_eq_def facesAt_def)
apply (rule ballI)
apply (simp only: split_def Let_def)
apply (simp only: snd_conv)
apply (rule equalityI)
apply (rule subsetI)
apply (simp only: faceListAt.simps vertices_graph.simps split:if_split_asm)
apply (case_tac "v < |faceListAt g'| ∧ a < | faceListAt g'|")
apply (simp only: nth_append split: if_split_asm)
apply (case_tac "va < | faceListAt g' |")
apply (subgoal_tac "va ∈ 𝒱 g'")
apply (subgoal_tac "distinct vs1 ∧ distinct vs2 ∧
v ∉ set vs1 ∧ v ∉ set vs2 ∧ a ∉ set vs1 ∧ a ∉ set vs2 ∧ a ≠ v ∧ v ≠ a ∧ set vs1 ∩ set vs2 = {}" )
apply (case_tac "a = va")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
apply (case_tac "x = f'") apply (simp add: vert_f21) apply(simp)
apply (case_tac "x = f21") apply (simp add: vert_f21) apply (simp)
apply (rule conjI)
apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps6) apply assumption apply assumption apply (simp add: facesAt_def)
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
apply (rule normFaces_distinct) apply (rule minGraphProps8) apply simp apply simp apply simp
apply (case_tac "v = va")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
apply (case_tac "x = f21") apply (simp add: vert_f21) apply simp
apply (rule conjI)
apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps6) apply assumption apply assumption apply(fastforce simp: facesAt_def)
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
apply (rule normFaces_distinct) apply (rule minGraphProps8) apply simp apply simp apply simp
apply (case_tac "va ∈ set vs1")
apply (subgoal_tac "va ∉ set vs2")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply (simp add: vert_f12) apply simp
apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
apply (rule conjI)
apply (rule disjI2)
apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps6) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption
apply blast
apply (case_tac "va ∈ set vs2")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f21") apply (simp add: vert_f21) apply simp
apply (case_tac "x = f'") apply (simp add: vert_f21) apply simp
apply (rule conjI)
apply (rule disjI2)
apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps6) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f'")
apply (subgoal_tac "va ∈ 𝒱 f'") apply simp
apply (rule minGraphProps6) apply simp apply (simp add: fla)
apply (simp add: facesAt_def)
apply simp
apply (rule conjI)
apply (rule disjI2) apply (rule disjI2)
apply (rule minGraphProps5) apply assumption apply assumption apply (fastforce simp: facesAt_def)
apply (rule minGraphProps6) apply assumption apply assumption apply(fastforce simp: facesAt_def)
apply (rule minGraphProps11') apply assumption
apply (subgoal_tac "distinct (facesAt g' va)") apply (simp add: facesAt_def)
apply (rule normFaces_distinct) apply (rule minGraphProps8) apply assumption apply assumption apply simp
apply (subgoal_tac "distinct (vertices f12) ∧ distinct (vertices f21)")
apply (simp add: vert_f12 vert_f21)
apply (rule vs1_vs2_empty)
apply (subgoal_tac "pre_split_face f' v a ws")
apply (simp add: f12_def f21_def split_face_distinct1' split_face_distinct2')
apply simp
apply (simp add: vertices_graph fla)
apply simp
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (subgoal_tac "(va - |faceListAt g'| ) < | ws |") apply simp apply (rule conjI) apply blast
apply (subgoal_tac "va ∈ set ws")
apply (case_tac "x = f12") apply (simp add: vert_f12) apply (simp add: vert_f21)
apply (simp add: ws_def fla)
apply (simp add: ws_def fla)
apply (rule minGraphProps11') apply assumption
apply (subgoal_tac "v ∈ 𝒱 g' ∧ a ∈ 𝒱 g'")
apply (simp only: fla in_vertices_graph)
apply (subgoal_tac "f' ∈ ℱ g'")
apply (subgoal_tac "v ∈ 𝒱 f' ∧ a ∈ 𝒱 f'") apply (simp only: minGraphProps9) apply force
apply (subgoal_tac "pre_split_face f' v a ws") apply (simp only: pre_split_face_def) apply force
apply (rule pre_splitFace_pre_split_face) apply assumption
apply (simp only: pre_splitFace_def)
apply (rule subsetI)
apply (case_tac "v < |faceListAt g'| ∧ a < | faceListAt g'|")
apply (case_tac "va < | faceListAt g' |")
apply (subgoal_tac "va ∈ 𝒱 g'")
apply (subgoal_tac "distinct vs1 ∧ distinct vs2 ∧
v ∉ set vs1 ∧ v ∉ set vs2 ∧ a ∉ set vs1 ∧ a ∉ set vs2 ∧ a ≠ v ∧ v ≠ a ∧ set vs1 ∩ set vs2 = {}" )
apply (simp del: replacefacesAt_simps add: nth_append)
apply (case_tac "a = va")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply simp apply (rule minGraphProps7') apply simp apply simp apply simp
apply (rule minGraphProps11') apply simp
apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply assumption
apply simp
apply (case_tac "v = va")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply simp apply (rule minGraphProps7') apply simp apply simp apply simp
apply (rule minGraphProps11') apply simp apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp apply (case_tac "va ∈ set vs1")
apply (subgoal_tac "va ∉ set vs2")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f12") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply (case_tac "x = f'")
apply (subgoal_tac "f' ≠ f21") apply simp apply (rule splitFace_f21_oldF_neq)
apply (rule pre_F')
apply simp
apply (rule fdg)
apply (case_tac "x = f21") apply (simp add: vert_f21 fla) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (simp add: ws_def)
apply simp apply (rule minGraphProps7') apply simp apply simp apply simp
apply (rule minGraphProps11') apply simp
apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
apply blast
apply (case_tac "va ∈ set vs2")
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faceListAt g' ! va)")
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (case_tac "x = f21") apply simp apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp apply simp
apply (case_tac "x = f'")
apply (subgoal_tac "f' ≠ f12") apply simp apply (rule splitFace_f12_oldF_neq)
apply (rule pre_F') apply simp apply (rule fdg)
apply (case_tac "x = f12") apply (simp add: vert_f12 fla) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (simp add: ws_def)
apply simp apply (rule minGraphProps7') apply simp apply simp apply simp
apply (rule minGraphProps11') apply simp apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
apply (simp add:replacefacesAt_nth2 replacefacesAt_notin replacefacesAt_in)
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (rule minGraphProps7') apply simp
apply (case_tac "x = f21") apply (simp add: vert_f21) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (simp add: ws_def vertices_graph)
apply (case_tac "x = f12") apply (simp add: vert_f12) apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (simp add: ws_def vertices_graph)
apply simp
apply simp
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "distinct (vertices f12) ∧ distinct (vertices f21)")
apply (simp add: vert_f12 vert_f21)
apply (rule vs1_vs2_empty)
apply (subgoal_tac "pre_split_face f' v a ws")
apply (simp add: f12_def f21_def split_face_distinct1' split_face_distinct2')
apply (simp add: pre_splitFace_pre_split_face[OF pre_F'])
apply (simp add: vertices_graph fla)
apply (simp add: nth_append del:replacefacesAt_simps)
apply (subgoal_tac "distinct (faces g')")
apply (simp add: replace6)
apply (thin_tac "[countVertices g'..<countVertices g' + n] = ws")
apply (subgoal_tac "(va - |faceListAt g'| ) < |ws|") apply simp
apply (rule ccontr) apply simp
apply (case_tac "x = f'") apply simp apply simp
apply (subgoal_tac "va ∈ 𝒱 g'") apply (simp add: fla vertices_graph)
apply (rule minGraphProps9) apply simp apply force
apply (simp add: fla) apply (metis minGraphProps9')
apply (simp add: ws_def fla)
apply (rule minGraphProps11') apply simp
apply (subgoal_tac "v ∈ 𝒱 g' ∧ a ∈ 𝒱 g'")
apply (simp only: fla in_vertices_graph)
apply (subgoal_tac "f' ∈ ℱ g'")
apply (subgoal_tac "v ∈ 𝒱 f' ∧ a ∈ 𝒱 f'") apply (simp only: minGraphProps9) apply force
by force
qed
lemma splitFace_holds_faces_subset:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
shows "faces_subset (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
define g'' where "g'' = (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
define ws where "ws = [countVertices g'..<countVertices g' + n]"
define f21 where "f21 = snd (split_face f' v a ws)"
define f12 where "f12 = fst (split_face f' v a ws)"
define vs1 where "vs1 = between (vertices f') v a"
define vs2 where "vs2 = between (vertices f') a v"
from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g''_def
have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
by (simp add: splitFace_def split_def)
from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force
from f12_def vs1_def have vert_f12: "vertices f12 = rev ws @ v # vs1 @ [a]" by (simp add: split_face_def)
from f21_def vs2_def have vert_f21: "vertices f21 = a # vs2 @ v # ws" by (simp add: split_face_def)
from vs1_def vs2_def pre_F have vertFrom_f': "verticesFrom f' v =
v # vs1 @ a # vs2" apply simp
apply (rule_tac verticesFrom_ram1) by (rule pre_splitFace_pre_split_face)
from vs1_def vs2_def pre_F vertFrom_f' have vert_f': "𝒱 f' = set vs1 ∪ set vs2 ∪ {a,v}"
apply (subgoal_tac "(vertices f') ≅ (verticesFrom f' v)") apply (drule congs_pres_nodes)
apply (simp add: congs_pres_nodes) apply blast
apply (rule verticesFrom_congs) by (simp only: pre_splitFace_def)
from ws_def f21_def f12_def have faces:"faces g'' = (replace f' [f21] (faces g')) @ [f12]"
apply (simp add: g''_def) by (simp add: splitFace_def split_def)
from ws_def have vertices:"vertices g'' = vertices g' @ ws" by (simp add: g''_def)
from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric]
vs1_def [symmetric] vs2_def [symmetric] pre_F mgp g''_def [symmetric] show ?thesis
apply (simp add: faces_subset_def) apply (rule ballI) apply (simp add: faces vertices)
apply (subgoal_tac "𝒱 f' ⊆ 𝒱 g'")
apply (case_tac "f = f12") apply (simp add: vert_f12 vert_f') apply force
apply simp apply (drule replace5)
apply (case_tac "f = f21") apply (simp add: vert_f21 vert_f') apply force
apply simp apply (rule subsetI) apply (frule minGraphProps9) apply assumption+ apply simp
apply (rule subsetI) apply (rule minGraphProps9) by auto
qed
lemma splitFace_holds_edges_sym:
assumes pre_F: "pre_splitFace g' v a f' ws"
and mgp: "minGraphProps g'"
shows "edges_sym (snd (snd (splitFace g' v a f' ws)))"
proof -
define g'' where "g'' = (snd (snd (splitFace g' v a f' ws)))"
define f21 where "f21 = snd (split_face f' v a ws)"
define f12 where "f12 = fst (split_face f' v a ws)"
define vs1 where "vs1 = between (vertices f') v a"
define vs2 where "vs2 = between (vertices f') a v"
from f21_def [symmetric] f12_def [symmetric] g''_def
have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
by (simp add: splitFace_def split_def)
from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def) by force
from f21_def f12_def have faces:"faces g'' = (replace f' [f21] (faces g')) @ [f12]"
apply (simp add: g''_def) by (simp add: splitFace_def split_def)
from f12_def f21_def have split: "(f12, f21) = split_face f' v a ws" by simp
from pre_F mgp g''_def [symmetric] split show ?thesis
apply (simp add: edges_sym_def edges_graph_def f21_def [symmetric] f12_def [symmetric]
vs1_def [symmetric] vs2_def [symmetric])
apply (intro allI impI) apply (elim bexE) apply (simp add: faces)
apply (case_tac "x = f12 ∨ x = f21")
apply (subgoal_tac "(aa,b) ∈ edges f' ∨ ((b,aa) ∈ (edges f12 ∪ edges f21) ∧ (aa,b) ∈ (edges f12 ∪ edges f21))") apply simp
apply (case_tac "(aa, b) ∈ edges f'")
apply (subgoal_tac "(b,aa) ∈ edges g'")
apply (simp add: edges_graph_def) apply (elim bexE) apply (rule disjI2) apply (rule bexI)
apply simp
apply (subgoal_tac "xa ≠ f'") apply (rule replace4) apply simp apply force
apply (drule minGraphProps12) apply simp apply simp
apply (rule ccontr) apply simp
apply (rule minGraphProps10) apply simp apply (simp add: edges_graph_def)
apply (rule bexI) apply (thin_tac "(aa, b) ∈ edges x") apply simp
apply simp
apply simp
apply (case_tac "(b, aa) ∈ edges f12") apply simp apply simp
apply (case_tac "(b, aa) ∈ edges f21") apply (rule bexI)
apply simp
apply (rule replace3) apply simp
apply simp
apply simp
apply (subgoal_tac "
((aa,b) ∈ edges f' ∨ ((b,aa) ∈ (edges f12 ∪ edges f21) ∧ (aa,b) ∈ (edges f12 ∪ edges f21))) = ((aa,b) ∈ edges f12 ∨ (aa,b) ∈ edges f21)") apply force
apply (rule sym) apply simp
apply (rule split_face_edges_f12_f21_sym) apply (erule pre_splitFace_oldF)
apply (subgoal_tac "pre_split_face f' v a ws") apply assumption apply simp
apply (rule split)
apply simp
apply (subgoal_tac "distinct (faces g')") apply (simp add: replace6)
apply (case_tac "x = f'") apply simp apply simp
apply (subgoal_tac "(b,aa) ∈ edges g'")
apply (simp add: edges_graph_def) apply (elim bexE)
apply (case_tac "xa = f'")
apply simp apply (frule split_face_edges_or) apply simp apply simp
apply (case_tac "(b, aa) ∈ edges f12") apply simp apply simp
apply (rule bexI) apply (thin_tac "(b, aa) ∈ edges f'")
apply simp
apply (rule replace3) apply simp apply simp
apply (rule disjI2) apply (rule bexI) apply simp
apply (rule replace4) apply simp
apply force
apply (rule minGraphProps10) apply simp
apply (simp add: edges_graph_def)
apply (rule bexI) apply simp apply simp
apply (rule minGraphProps11') by simp
qed
lemma splitFace_holds_faces_distinct:
assumes pre_F: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and mgp: "minGraphProps g'"
shows "faces_distinct (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
define g'' where "g'' = snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n]))"
define ws where "ws ≡ [countVertices g'..<countVertices g' + n]"
define f21 where "f21 = snd (split_face f' v a ws)"
define f12 where "f12 = fst (split_face f' v a ws)"
define vs1 where "vs1 = between (vertices f') v a"
define vs2 where "vs2 = between (vertices f') a v"
from ws_def [symmetric] f21_def [symmetric] f12_def [symmetric] g''_def
have fdg: "(f12, f21, g'') = splitFace g' v a f' ws"
by (simp add: splitFace_def split_def)
from pre_F have pre_F': "pre_splitFace g' v a f' ws" apply (unfold pre_splitFace_def ws_def) by force
from ws_def f21_def f12_def have faces:"faces g'' = (replace f' [f21] (faces g')) @ [f12]"
apply (simp add: g''_def) by (simp add: splitFace_def split_def)
from f12_def f21_def have split: "(f12, f21) = split_face f' v a ws" by simp
from ws_def [symmetric] pre_F mgp g''_def [symmetric] split show ?thesis
apply (simp add: faces_distinct_def faces)
apply (subgoal_tac "distinct (normFaces (replace f' [f21] (faces g')))")
apply (simp add: normFaces_def)
apply safe
apply (subgoal_tac "distinct (faces g')") apply (simp add: replace6)
apply (case_tac "x = f'") apply simp
apply (subgoal_tac "f' ≠ f21") apply simp
apply (rule splitFace_f21_oldF_neq)
apply (rule pre_F') apply simp
apply (rule fdg)
apply simp
apply (case_tac "x = f21") apply simp
apply (subgoal_tac "normFace f12 ≠ normFace f21") apply simp
apply (rule splitFace_f12_f21_neq_norm) apply force apply simp
apply (simp add: fdg) apply (rule fdg)
apply simp
apply (subgoal_tac "normFace f12 ∉ set (normFaces (faces g'))")
apply (simp add: normFaces_def)
apply (rule splitFace_new_f12_norm) apply (rule pre_F') apply simp
apply (rule fdg)
apply (rule minGraphProps11') apply simp
apply (rule distinct_replace_norm) apply (rule minGraphProps11) apply simp
apply (simp add: normFaces_def)
apply (subgoal_tac "normFace f21 ∉ set (normFaces (faces g'))")
apply (simp add: normFaces_def)
apply (rule splitFace_new_f21_norm) apply (rule pre_F') apply simp
by (rule fdg)
qed
lemma "help":
shows "xs ≠ [] ⟹ x ∉ set xs ⟹ x ≠ hd xs" and
"xs ≠ [] ⟹ x ∉ set xs ⟹ x ≠ last xs" and
"xs ≠ [] ⟹ x ∉ set xs ⟹ hd xs ≠ x" and
"xs ≠ [] ⟹ x ∉ set xs ⟹ last xs ≠ x"
by(auto)
lemma split_face_edge_disj:
"⟦ pre_split_face f a b vs; (f⇩1, f⇩2) = split_face f a b vs; |vertices f| ≥ 3;
vs = [] ⟶ (a,b) ∉ edges f ∧ (b,a) ∉ edges f ⟧
⟹ ℰ f⇩1 ∩ ℰ f⇩2 = {}"
apply(frule pre_split_face_p_between[THEN between_inter_empty])
apply(unfold pre_split_face_def)
apply clarify
apply(subgoal_tac "⋀x y. x ∈ set vs ⟹ y ∈ 𝒱 f ⟹ x ≠ y")
prefer 2 apply blast
apply(subgoal_tac "⋀x y. x ∈ set vs ⟹ y ∈ 𝒱 f ⟹ y ≠ x")
prefer 2 apply blast
apply(subgoal_tac "a ∉ set vs")
prefer 2 apply blast
apply(subgoal_tac "b ∉ set vs")
prefer 2 apply blast
apply(subgoal_tac "distinct(vs @ a # between (vertices f) a b @ [b])")
prefer 2 apply(simp add:between_not_r1 between_not_r2 between_distinct)
apply(blast dest:inbetween_inset)
apply(subgoal_tac "distinct(b # between (vertices f) b a @ a # rev vs)")
prefer 2 apply(simp add:between_not_r1 between_not_r2 between_distinct)
apply(blast dest:inbetween_inset)
apply(subgoal_tac "vs = [] ⟹ between (vertices f) a b ≠ []")
prefer 2 apply clarsimp apply(frule (4) is_nextElem_between_empty')apply blast
apply(subgoal_tac "vs = [] ⟹ between (vertices f) b a ≠ []")
prefer 2 apply clarsimp
apply(frule (3) is_nextElem_between_empty')apply simp apply blast
apply(subgoal_tac "vs ≠ [] ⟹ hd vs ∉ 𝒱 f")
prefer 2 apply(drule hd_in_set) apply blast
apply(subgoal_tac "vs ≠ [] ⟹ last vs ∉ 𝒱 f")
prefer 2 apply(drule last_in_set) apply blast
apply(subgoal_tac "⋀u v. between (vertices f) u v ≠ [] ⟹ hd(between (vertices f) u v) ∈ 𝒱 f")
prefer 2 apply(drule hd_in_set)apply(drule inbetween_inset) apply blast
apply(subgoal_tac "⋀u v. between (vertices f) u v ≠ [] ⟹ last (between (vertices f) u v) ∈ 𝒱 f")
prefer 2 apply(drule last_in_set) apply(drule inbetween_inset) apply blast
apply(simp add:split_face_def edges_conv_Edges Edges_append Edges_Cons
last_rev notinset_notinEdge1 notinset_notinEdge2 notinset_notinbetween
between_not_r1 between_not_r2 "help" Edges_rev_disj disj_sets_disj_Edges
Int_Un_distrib Int_Un_distrib2)
apply clarify
apply(rule conjI)
apply clarify
apply(rule disj_sets_disj_Edges)
apply simp
apply(blast dest:inbetween_inset)
apply clarify
apply(rule conjI)
apply clarify
apply(rule disj_sets_disj_Edges)
apply simp
apply(blast dest:inbetween_inset)
apply clarify
apply(rule conjI)
apply(rule disj_sets_disj_Edges)
apply simp
apply(blast dest:inbetween_inset)
apply(rule disj_sets_disj_Edges)
apply(blast dest:inbetween_inset)
done
lemma splitFace_edge_disj:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and FDG: "(f⇩1,f⇩2,g') = splitFace g u v f vs"
shows "edges_disj g'"
proof -
from mgp have disj: "edges_disj g" by(simp add:minGraphProps_def)
have "𝒱 g ∩ set vs = {}" using pre
by (simp add: pre_splitFace_def)
hence gvs: "∀f ∈ ℱ g. 𝒱 f ∩ set vs = {}"
by (clarsimp simp:edges_graph_def edges_face_def)
(blast dest: minGraphProps9[OF mgp])
have f: "f ∈ ℱ g" by (rule pre_splitFace_oldF[OF pre])
note split_face = splitFace_split_face[OF f FDG]
note pre_split_face = pre_splitFace_pre_split_face[OF pre]
have "ℰ f⇩1 ∩ ℰ f⇩2 = {}"
apply(rule split_face_edge_disj[OF pre_split_face split_face mgp_vertices3[OF mgp f]])
using pre
apply(simp add:pre_splitFace_def del: pre_splitFace_oldF)
apply clarify
by(simp)
moreover
{ fix f' assume f': "f' ∈ ℱ g" "f' ≠ f"
have "(ℰ f⇩1 ∪ ℰ f⇩2) ∩ ℰ f' = {}"
proof cases
assume vs: "vs = []"
have "(u,v) ∉ ℰ g ∧ (v,u) ∉ ℰ g" using pre vs
by(simp add:pre_splitFace_def)
with split_face_edges_f12_f21_vs[OF pre_split_face[simplified vs] split_face[simplified vs]]
show ?thesis using f f' disj
by(simp add:is_duplicateEdge_def edges_graph_def edges_disj_def)
next
assume vs: "vs ≠ []"
have f12: "vs ≠ [] ⟹ ℰ f⇩1 ∪ ℰ f⇩2 ⊆
ℰ f ∪ UNIV × set vs ∪ set vs × UNIV"
using split_face_edges_f12_f21[OF pre_split_face split_face]
by simp (fastforce dest:in_Edges_in_set)
have "⋀x y. (y,x) ∈ ℰ f' ⟹ x ∉ set vs ∧ y ∉ set vs"
using f' gvs by(blast dest:in_edges_in_vertices)
then show ?thesis using f f' f12 disj vs
by(simp add: edges_graph_def edges_disj_def) blast
qed }
ultimately show ?thesis using disj
by(simp add:edges_disj_def set_faces_splitFace[OF mgp f pre FDG])
blast
qed
lemma splitFace_edges_disj2:
"minGraphProps g ⟹ pre_splitFace g u v f vs
⟹ edges_disj(snd(snd(splitFace g u v f vs)))"
apply(subgoal_tac "pre_splitFace g u v f vs")
prefer 2 apply(simp)
by(drule (1) splitFace_edge_disj[where f⇩1 = "fst(splitFace g u v f vs)" and f⇩2 = "fst(snd(splitFace g u v f vs))"], auto)
lemma vertices_conv_Union_edges2:
"distinct(vertices f) ⟹ 𝒱(f::face) = (⋃(a,b)∈ℰ f. {b})"
apply auto
apply(fast intro: prevVertex_in_edges)
done
lemma splitFace_face_face_op:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and fdg: "(f⇩1,f⇩2,g') = splitFace g u v f vs"
shows "face_face_op g'"
proof -
have f12: "(f⇩1, f⇩2) = split_face f u v vs"
and Fg': "ℱ g' = {f⇩1} ∪ set(replace f [f⇩2] (faces g))"
and g': "g' = snd (snd (splitFace g u v f vs))" using fdg
by(auto simp add:splitFace_def split_def)
have f⇩1: "f⇩1= fst(split_face f u v vs)" and f⇩2: "f⇩2 = snd(split_face f u v vs)"
using f12[symmetric] by simp_all
note distF = minGraphProps11'[OF mgp]
note pre_split = pre_splitFace_pre_split_face[OF pre]
note distf⇩1 = split_face_distinct1[OF f12 pre_split]
note distf⇩2 = split_face_distinct2[OF f12 pre_split]
from pre have nf: "¬ final f" and fg: "f ∈ ℱ g" and nuv: "u ≠ v"
and uinf: "u ∈ 𝒱 f"and vinf: "v ∈ 𝒱 f"
and distf: "distinct(vertices f)" and new: "𝒱 g ∩ set vs = {}"
by(unfold pre_splitFace_def, simp)+
let ?fuv = "between (vertices f) u v" and ?fvu = "between (vertices f) v u"
have E⇩1: "ℰ f⇩1 = Edges (v # rev vs @ [u]) ∪ Edges (u # ?fuv @ [v])"
using f⇩1 by(simp add:edges_split_face1[OF pre_split])
have E⇩2: "ℰ f⇩2 = Edges (u # vs @ [v]) ∪ Edges (v # ?fvu @ [u])"
using f⇩2 by(simp add:edges_split_face2[OF pre_split])
have vf⇩1: "vertices f⇩1 = rev vs @ u # ?fuv @ [v]"
using f⇩1 by(simp add:split_face_def)
have vf⇩2: "vertices f⇩2 = [v] @ ?fvu @ u # vs"
using f⇩2 by(simp add:split_face_def)
have V⇩1: "𝒱 f⇩1 = {u,v} ∪ set(?fuv) ∪ set(vs)" using vf⇩1 by auto
have V⇩2: "𝒱 f⇩2 = {u,v} ∪ set(?fvu) ∪ set(vs)" using vf⇩2 by auto
have 2: "(v,u) ∈ ℰ f⇩1 ∧ (u,v) ∈ ℰ f⇩2 ∧ vs = [] ∨
(∃v ∈ 𝒱 f⇩1 ∩ 𝒱 f⇩2. v ∉ 𝒱 g)"
using E⇩1 E⇩2 V⇩1 V⇩2 new by(cases vs)(simp_all add:Edges_Cons)
have "𝒱 f⇩1 ≠ 𝒱 f⇩2"
proof cases
assume A: "?fvu = []"
have "?fuv ≠ []"
proof
assume "?fuv = []"
with A have "ℰ f = {(v,u),(u,v)}"
using edges_conv_Un_Edges[OF distf uinf vinf nuv]
by(simp add:Edges_Cons)
hence "𝒱 f = {u,v}" by(simp add:vertices_conv_Union_edges)
hence "card(𝒱 f) ≤ 2" by(simp add:card_insert_if)
thus False
using mgp_vertices3[OF mgp fg] by(simp add:distinct_card[OF distf])
qed
moreover have "set ?fuv ∩ set vs = {}"
using new minGraphProps9[OF mgp fg inbetween_inset] by blast
moreover have "{u,v} ∩ set ?fuv = {}"
using between_not_r1[OF distf] between_not_r2[OF distf] by blast
ultimately show ?thesis using V⇩1 V⇩2 A by (auto simp:neq_Nil_conv)
next
assume "?fvu ≠ []"
moreover have "{u,v} ∩ set ?fvu = {}"
using between_not_r1[OF distf] between_not_r2[OF distf] by blast
moreover have "set ?fuv ∩ set ?fvu = {}"
by(simp add:pre_between_def between_inter_empty distf uinf vinf nuv)
moreover have "set ?fvu ∩ set vs = {}"
using new minGraphProps9[OF mgp fg inbetween_inset] by blast
ultimately show ?thesis using V⇩1 V⇩2 by (auto simp:neq_Nil_conv)
qed
have C12: "ℰ f⇩1 ≠ (ℰ f⇩2)¯"
proof
assume A: "ℰ f⇩1 = (ℰ f⇩2)¯"
show False
proof -
have "𝒱 f⇩1 = (⋃(a,b)∈ℰ f⇩1. {a})"
by(rule vertices_conv_Union_edges)
also have "… = (⋃(b,a)∈ℰ f⇩2. {a})" by(auto simp:A)
also have "… = 𝒱 f⇩2"
by(rule vertices_conv_Union_edges2[OF distf⇩2, symmetric])
finally show False using ‹𝒱 f⇩1 ≠ 𝒱 f⇩2› by blast
qed
qed
{ fix h :: face assume hg: "h ∈ ℱ g"
have "ℰ h ≠ (ℰ f⇩1)¯ ∧ ℰ h ≠ (ℰ f⇩2)¯" using 2
proof
assume "(v,u) ∈ ℰ f⇩1 ∧ (u,v) ∈ ℰ f⇩2 ∧ vs = []"
moreover hence "(u,v) ∉ ℰ g"
using pre by(unfold pre_splitFace_def)simp
moreover hence "(v,u) ∉ ℰ g" by(blast intro:minGraphProps10[OF mgp])
ultimately show ?thesis using hg by(simp add:edges_graph_def) blast
next
assume "∃x ∈ 𝒱 f⇩1 ∩ 𝒱 f⇩2. x ∉ 𝒱 g"
then obtain x where "x ∈ 𝒱 f⇩1" and "x ∈ 𝒱 f⇩2" and "x ∉ 𝒱 g"
by blast
obtain y where "(x,y) ∈ ℰ f⇩1" using ‹x ∈ 𝒱 f⇩1›
by(auto simp:vertices_conv_Union_edges)
moreover obtain z where "(x,z) ∈ ℰ f⇩2" using ‹x ∈ 𝒱 f⇩2›
by(auto simp:vertices_conv_Union_edges)
moreover have "¬(∃y. (y,x) ∈ ℰ h)"
using ‹x ∉ 𝒱 g› minGraphProps9[OF mgp hg]
by(blast dest:in_edges_in_vertices)
ultimately show ?thesis by blast
qed
}
note Cg12 = this
show ?thesis
proof cases
assume 2: "|faces g| = 2"
with fg obtain f' where Fg: "ℱ g = {f,f'}"
by(fastforce simp: eval_nat_numeral length_Suc_conv)
moreover hence "f ≠ f'" using 2 distinct_card[OF distF] by auto
ultimately have Fg': "ℱ g' = {f⇩1,f⇩2,f'}"
using set_faces_splitFace[OF mgp fg pre fdg] by blast
show ?thesis using Fg' C12 Cg12 Fg
by(fastforce simp:face_face_op_def)
next
assume "|faces g| ≠ 2"
hence E: "⋀f f'. f∈ℱ g ⟹ f'∈ℱ g ⟹ f ≠ f' ⟹ ℰ f ≠ (ℰ f')¯"
using mgp by(simp add:minGraphProps_def face_face_op_def)
thus ?thesis using set_faces_splitFace[OF mgp fg pre fdg] C12 Cg12
by(fastforce simp:face_face_op_def)
qed
qed
lemma splitFace_face_face_op2:
"minGraphProps g ⟹ pre_splitFace g u v f vs
⟹ face_face_op(snd(snd(splitFace g u v f vs)))"
apply(subgoal_tac "pre_splitFace g u v f vs")
prefer 2 apply(simp)
by(drule (1) splitFace_face_face_op[where f⇩1 = "fst(splitFace g u v f vs)" and f⇩2 = "fst(snd(splitFace g u v f vs))"], auto)
lemma splitFace_holds_minGraphProps:
assumes precond: "pre_splitFace g' v a f' [countVertices g'..<countVertices g' + n]"
and min: "minGraphProps g'"
shows "minGraphProps (snd (snd (splitFace g' v a f' [countVertices g'..<countVertices g' + n])))"
proof -
from min have "minGraphProps' g'" by (simp add: minGraphProps_def)
then show ?thesis apply (simp add: minGraphProps_def) apply safe
apply (rule splitFace_holds_minGraphProps') apply (rule precond) apply assumption
apply (rule splitFace_holds_facesAt_eq) apply (rule precond) apply (rule min) apply simp
apply (rule splitFace_holds_faceListAt_len) apply (rule precond) apply (rule min)
apply (rule splitFace_holds_facesAt_distinct) apply (rule precond) apply (rule min)
apply (rule splitFace_holds_faces_distinct) apply (rule precond) apply (rule min)
apply (rule splitFace_holds_faces_subset) apply (rule precond) apply (rule min)
apply (rule splitFace_holds_edges_sym) apply (rule precond) apply (rule min)
apply (rule splitFace_edges_disj2) apply (rule min) apply (rule precond)
apply (rule splitFace_face_face_op2) apply (rule min) apply (rule precond)
done
qed
subsection‹Invariants of @{const makeFaceFinal}›
lemma MakeFaceFinal_minGraphProps':
"f ∈ ℱ g ⟹ minGraphProps g ⟹ minGraphProps' (makeFaceFinal f g)"
apply (simp add: minGraphProps_def minGraphProps'_def makeFaceFinal_def)
apply (subgoal_tac "2 < |vertices f| ∧ distinct (vertices f)")
apply (rule ballI) apply (elim conjE ballE) apply (rule conjI) apply simp apply simp
apply (simp add: makeFaceFinalFaceList_def) apply (drule replace5) apply (simp add: setFinal_def)
by force
lemma MakeFaceFinal_facesAt_eq:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ facesAt_eq (makeFaceFinal f g)"
apply (simp add: facesAt_eq_def) apply (rule ballI)
apply (subgoal_tac "v ∈ 𝒱 g")
apply (rule equalityI)
apply (rule subsetI)
apply (simp add: makeFaceFinal_def facesAt_def)
apply (subgoal_tac "v < | faceListAt g | ")
apply (simp add: makeFaceFinalFaceList_def)
apply (subgoal_tac "distinct ((faceListAt g ! v))")
apply (subgoal_tac "distinct (faces g)")
apply (simp add: replace6)
apply (case_tac "x = f")
apply simp apply (erule (1) minGraphProps6) apply (simp add: facesAt_def) apply blast
apply simp
apply (case_tac " f ∈ set (faceListAt g ! v) ∧ x = setFinal f") apply simp
apply (subgoal_tac "v ∈ 𝒱 f") apply (simp add: setFinal_def)
apply (erule (1) minGraphProps6) apply (simp add: facesAt_def)
apply simp
apply (rule conjI) apply (rule disjI2)
apply (erule (1) minGraphProps5) apply (fastforce simp: facesAt_def)
apply (erule (1) minGraphProps6) apply (fastforce simp: facesAt_def)
apply (rule minGraphProps11') apply simp
apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
apply (simp add: vertices_graph minGraphProps4)
apply (rule subsetI) apply (simp add: makeFaceFinal_def facesAt_def)
apply (subgoal_tac "v < | faceListAt g | ") apply simp
apply (subgoal_tac "distinct (faceListAt g ! v)")
apply (subgoal_tac "distinct (faces g)")
apply (simp add: makeFaceFinalFaceList_def replace6)
apply (case_tac "x = setFinal f") apply simp
apply (rule disjI1) apply (rule minGraphProps7') apply simp apply simp
apply (simp add: setFinal_def) apply simp
apply (rule minGraphProps7') apply simp apply simp apply simp
apply (rule minGraphProps11') apply simp
apply (rule normFaces_distinct) apply (rule minGraphProps8a) apply simp apply simp
apply (simp add: vertices_graph minGraphProps4)
apply (simp add: makeFaceFinal_def) by (simp add: in_vertices_graph minGraphProps4)
lemma MakeFaceFinal_faceListAt_len:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ faceListAt_len (makeFaceFinal f g)"
apply (simp add: faceListAt_len_def makeFaceFinal_def) apply (rule minGraphProps4) by simp
lemma normFaces_makeFaceFinalFaceList: "(normFaces (makeFaceFinalFaceList f fs)) = (normFaces fs)"
apply (simp add: normFaces_def) apply (simp add: makeFaceFinalFaceList_def)
apply (induct fs) apply simp apply simp apply (rule impI)
by (simp add: setFinal_def normFace_def verticesFrom_def minVertex_def)
lemma MakeFaceFinal_facesAt_distinct:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ facesAt_distinct (makeFaceFinal f g)"
apply (simp add: facesAt_distinct_def makeFaceFinal_def)
apply (clarsimp simp: facesAt_def)
apply (subgoal_tac "v < | (faceListAt g) |") apply (simp add: normFaces_makeFaceFinalFaceList)
apply (rule minGraphProps8a') apply simp apply simp by (simp add: minGraphProps4)
lemma MakeFaceFinal_faces_subset:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ faces_subset (makeFaceFinal f g)"
apply (simp add: faces_subset_def) apply (intro ballI subsetI)
apply (simp add: makeFaceFinal_def makeFaceFinalFaceList_def)
apply (drule replace5)
apply (case_tac "fa ∈ ℱ g") apply simp apply (rule minGraphProps9')
apply simp apply (thin_tac "f ∈ ℱ g") apply simp+
apply (rule minGraphProps9') apply simp apply simp by (simp add: setFinal_def)
lemma MakeFaceFinal_edges_sym:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ edges_sym (makeFaceFinal f g)"
apply (simp add: edges_sym_def) apply (intro allI impI)
apply (simp add: makeFaceFinal_def edges_graph_def)
apply (elim bexE) apply (simp add: makeFaceFinalFaceList_def)
apply (subgoal_tac "distinct (faces g)")
apply (case_tac "x ∈ ℱ g")
apply (subgoal_tac "(a,b) ∈ edges g") apply (frule minGraphProps10) apply assumption
apply (simp add: edges_graph_def) apply (elim bexE)
apply (case_tac "xb = f")
apply (subgoal_tac "(b,a) ∈ edges (setFinal f)")
apply (rule bexI) apply (rotate_tac -1) apply assumption
apply (rule replace3) apply simp apply simp
apply (subgoal_tac "distinct (vertices f)")
apply (simp add: edges_setFinal)
apply (rule minGraphProps3) apply simp apply simp
apply (rule bexI) apply assumption apply (rule replace4) apply simp apply force
apply (simp add: edges_graph_def) apply force
apply (frule replace5) apply simp
apply (subgoal_tac "(a,b) ∈ edges g")
apply (frule minGraphProps10) apply assumption apply (simp add: edges_graph_def) apply (elim bexE)
apply (case_tac "xb = f")
apply (subgoal_tac "(b, a) ∈ edges (setFinal f)")
apply (rule bexI) apply (rotate_tac -1) apply assumption
apply (rule replace3) apply simp apply simp
apply (subgoal_tac "distinct (vertices f)")
apply (simp add: edges_setFinal)
apply (rule minGraphProps3) apply simp apply simp
apply (rule bexI) apply simp apply (rule replace4) apply simp apply force
apply (subgoal_tac "distinct (vertices f)")
apply (subgoal_tac "(a,b) ∈ edges f")
apply (simp add: edges_graph_def) apply force
apply (simp add: edges_setFinal)
apply (rule minGraphProps3) apply simp apply simp
by (rule minGraphProps11')
lemma MakeFaceFinal_faces_distinct:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ faces_distinct (makeFaceFinal f g)"
apply (simp add: faces_distinct_def makeFaceFinal_def normFaces_makeFaceFinalFaceList)
by (rule minGraphProps11)
lemma MakeFaceFinal_edges_disj:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ edges_disj (makeFaceFinal f g)"
apply(frule minGraphProps11')
apply (clarsimp simp: edges_disj_def makeFaceFinal_def edges_graph_def
makeFaceFinalFaceList_def replace6)
apply(case_tac "f = f'")
apply (fastforce dest:mgp_edges_disj)
apply (fastforce dest:mgp_edges_disj)
done
lemma MakeFaceFinal_face_face_op:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ face_face_op (makeFaceFinal f g)"
apply(subgoal_tac "face_face_op g")
prefer 2 apply(simp add:minGraphProps_def)
apply(drule minGraphProps11')
apply(auto simp: face_face_op_def makeFaceFinal_def makeFaceFinalFaceList_def
distinct_set_replace)
done
lemma MakeFaceFinal_minGraphProps:
"f ∈ ℱ g ⟹ minGraphProps g ⟹ minGraphProps (makeFaceFinal f g)"
apply (simp (no_asm) add: minGraphProps_def)
apply (simp add: MakeFaceFinal_minGraphProps' MakeFaceFinal_facesAt_eq
MakeFaceFinal_faceListAt_len MakeFaceFinal_facesAt_distinct
MakeFaceFinal_faces_subset MakeFaceFinal_edges_sym
MakeFaceFinal_edges_disj MakeFaceFinal_faces_distinct
MakeFaceFinal_face_face_op)
done
subsection‹Invariants of @{const subdivFace'}›
lemma subdivFace'_holds_minGraphProps: "⋀ f v' v n g.
pre_subdivFace' g f v' v n ovl ⟹ f ∈ ℱ g ⟹
minGraphProps g ⟹ minGraphProps (subdivFace' g f v n ovl)"
proof (induct ovl)
case Nil then show ?case by (simp add: MakeFaceFinal_minGraphProps)
next
case (Cons ov ovl) then show ?case
apply auto
apply (cases "ov")
apply (simp_all split: if_split_asm)
apply (rule Cons)
apply (rule pre_subdivFace'_None)
apply simp_all
apply (intro conjI)
apply clarsimp
apply (rule Cons)
apply (rule pre_subdivFace'_Some2)
apply simp_all
apply (clarsimp simp: split_def)
apply (rule Cons)
apply (rule pre_subdivFace'_Some1)
apply simp_all
apply (simp add: minGraphProps_def faces_subset_def)
apply (rule splitFace_add_f21')
apply simp_all
apply (rule splitFace_holds_minGraphProps)
apply simp_all
apply (rule pre_subdivFace'_preFaceDiv)
apply simp_all
by (simp add: minGraphProps_def faces_subset_def)
qed
abbreviation (input)
Edges_if :: "face ⇒ vertex ⇒ vertex ⇒ (vertex × vertex)set" where
"Edges_if f u v ==
if u=v then {} else Edges(u # between (vertices f) u v @ [v])"
lemma FaceDivsionGraph_one_final_but:
assumes mgp: "minGraphProps g" and pre: "pre_splitFace g u v f vs"
and fdg: "(f⇩1,f⇩2,g') = splitFace g u v f vs"
and nrv: "r ≠ v"
and ruv: "before (verticesFrom f r) u v" and rf: "r ∈ 𝒱 f"
and 1: "one_final_but g (Edges_if f r u)"
shows "one_final_but g' (Edges(r # between (vertices f⇩2) r v @ [v]))"
proof -
have f⇩1: "f⇩1= fst(split_face f u v vs)" and f⇩2: "f⇩2 = snd(split_face f u v vs)"
and F: "ℱ g' = {f⇩1} ∪ set(replace f [f⇩2] (faces g))"
and g': "g' = snd (snd (splitFace g u v f vs))" using fdg
by(auto simp add:splitFace_def split_def)
note pre_split = pre_splitFace_pre_split_face[OF pre]
from pre have nf: "¬ final f" and fg: "f ∈ ℱ g" and nuv: "u ≠ v"
and uinf: "u ∈ 𝒱 f"and vinf: "v ∈ 𝒱 f"
by(unfold pre_splitFace_def, simp)+
from mgp fg have distf: "distinct(vertices f)" by(rule minGraphProps3)
note distFg = minGraphProps11'[OF mgp]
have fvu: "r≠u ⟹ between (vertices f) v u =
between (vertices f) v r @ r # between (vertices f) r u"
using before_between2[OF ruv distf rf] nrv
split_between[OF distf vinf uinf, of r] by (auto)
let ?fuv = "between (vertices f) u v" and ?fvu = "between (vertices f) v u"
let ?fru = "between (vertices f) r u" and ?f⇩2rv = "between (vertices f⇩2) r v"
have E⇩1: "ℰ f⇩1 = Edges (v # rev vs @ [u]) ∪ Edges (u # ?fuv @ [v])"
using f⇩1 by(simp add:edges_split_face1[OF pre_split])
have E⇩2: "ℰ f⇩2 = Edges (u # vs @ [v]) ∪ Edges (v # ?fvu @ [u])"
using f⇩2 by(simp add:edges_split_face2[OF pre_split])
have vf⇩2: "vertices f⇩2 = [v] @ ?fvu @ u # vs"
using f⇩2 by(simp add:split_face_def)
have vinf⇩2: "v ∈ 𝒱 f⇩2" using vf⇩2 by(simp)
have rinf⇩2: "r ∈ 𝒱 f⇩2"
proof cases
assume "r=u" thus ?thesis by(simp add:vf⇩2)
next
assume "r≠u" thus ?thesis by(simp add: vf⇩2 fvu)
qed
have distf⇩2: "distinct(vertices f⇩2)"
by(simp add:f⇩2)(rule split_face_distinct2'[OF pre_split])
have f⇩2uv: "between (vertices f⇩2) u v = vs"
using vf⇩2 distf⇩2 by(simp add:between_def split_def)
have f⇩2ru: "r≠u ⟹ between (vertices f⇩2) r u = between (vertices f) r u"
using vf⇩2 fvu distf distf⇩2 by(simp add:between_def split_def)
hence f⇩2rv: "between (vertices f⇩2) r v =
(if r=u then [] else ?fru @ [u]) @ vs"
proof cases
assume "r=u" thus ?thesis by(simp add: f⇩2uv)
next
assume nru: "r ≠ u"
have vinf⇩2: "v ∈ 𝒱 f⇩2" by(simp add: vf⇩2)
note u_bet_rv = before_between[OF ruv distf rf nru]
have u_bet_rv⇩2: "u ∈ set (between (vertices f⇩2) r v)"
using distf⇩2 nru
apply(simp add:vf⇩2 fvu)
apply(subst between_def[of _ r v])
apply(simp add:split_def)
done
show ?thesis
by(simp add:split_between[OF distf⇩2 rinf⇩2 vinf⇩2 u_bet_rv⇩2] f⇩2ru f⇩2uv)
qed
have E⇩2rv: "Edges(r # ?f⇩2rv @ [v]) =
Edges_if f r u ∪ Edges(u # vs @ [v])" (is "?L = ?R")
proof -
have "?L = Edges((if r=u then [] else r # ?fru) @ (u # vs @ [v]))"
by (simp add: f⇩2rv)
also have "… = ?R" by(auto simp:Edges_Cons Edges_append)
finally show ?thesis .
qed
show ?thesis
proof (auto del: disjCI simp:one_final_but_def F, goal_cases)
case prems: (1 a b)
have ab: "(a,b) ∈ ℰ f⇩1"
and nab: "(a,b) ∉ Edges (r # ?f⇩2rv @ [v])" by fact+
have "(a,b) ∈ Edges (v # rev vs @ [u]) ∨
(a,b) ∈ Edges (u # ?fuv @ [v])" (is "?A ∨ ?B")
using E⇩1 ab by blast
thus ?case
proof
assume ?A
hence "(b,a) ∈ Edges (rev(v # rev vs @ [u]))" by (simp del:rev.simps)
hence "(b,a) ∈ Edges (r # ?f⇩2rv @ [v])" using E⇩2rv by simp
thus ?case by blast
next
assume abfuv: ?B
have abf: "(a,b) ∈ ℰ f"
by(rule Edges_between_edges[OF abfuv pre_split])
have "(∃f'∈set(replace f [f⇩2] (faces g)). final f' ∧ (b,a) ∈ ℰ f')"
proof cases
assume "r = u"
then obtain f' where "f' ∈ ℱ g ∧ final f' ∧ (b, a) ∈ ℰ f'"
using abf 1 nf fg by(simp add:one_final_but_def)fast
moreover then have "f' ∈ set (replace f [f⇩2] (faces g))"
by(clarsimp simp: replace6[OF distFg] nf)
ultimately show ?thesis by blast
next
assume nru: "r ≠ u"
moreover hence "(a,b) ∉ Edges (r # ?fru @ [u])"
using abfuv Edges_disj[OF distf rf vinf nru nuv
before_between[OF ruv distf rf nru]] by fast
moreover have "(b,a) ∉ Edges (r # ?fru @ [u])"
proof
assume "(b,a) ∈ Edges (r # ?fru @ [u])"
moreover have "pre_split_face f r u []"
by(simp add:pre_split_face_def distf rf uinf nru)
ultimately show False
using minGraphProps12[OF mgp fg abf]
by(blast dest:Edges_between_edges)
qed
ultimately obtain f' where "f' ∈ ℱ g ∧ final f' ∧ (b, a) ∈ ℰ f'"
using abf 1 nf fg by(simp add:one_final_but_def)fast
moreover hence "f' ∈ set (replace f [f⇩2] (faces g))"
by(clarsimp simp: replace6[OF distFg] nf)
ultimately show ?thesis by blast
qed
thus ?case ..
qed
next
case (2 f' a b)
have f': "f' ∈ set (replace f [f⇩2] (faces g))"
and nf': "¬ final f'" and abf': "(a,b) ∈ ℰ f'"
and nab: "(a,b) ∉ Edges (r # between (vertices f⇩2) r v @ [v])" by fact+
have "f' = f⇩2 ∨ f' ∈ ℱ g ∧ f' ≠ f"
using f' by(simp add:replace6[OF distFg]) blast
hence "(b, a) ∈ Edges (r # between (vertices f⇩2) r v @ [v]) ∨
(∃f'∈set (replace f [f⇩2] (faces g)). final f' ∧ (b, a) ∈ ℰ f')"
(is "?A ∨ ?B")
proof
assume [simp]: "f' = f⇩2"
have "(a,b) ∈ Edges (v # between (vertices f⇩2) v r @ [r])"
using abf' nab Edges_compl[OF distf⇩2 vinf⇩2 rinf⇩2 nrv[symmetric]]
edges_conv_Un_Edges[OF distf⇩2 rinf⇩2 vinf⇩2 nrv] by auto
moreover have eq: "between(vertices f⇩2) v r = between (vertices f) v r"
proof (cases "r=u")
assume "r=u" thus ?thesis
by(simp add:vf⇩2)(rule between_front[OF between_not_r2[OF distf]])
next
assume "r≠u" thus ?thesis
by(simp add:vf⇩2 fvu)(rule between_front[OF between_not_r2[OF distf]])
qed
ultimately
have abfvr: "(a,b) ∈ Edges (v # between (vertices f) v r @ [r])"
by simp
have abf: "(a,b) ∈ ℰ f"
apply(rule Edges_between_edges[where vs = "[]", OF abfvr])
using distf rf vinf nrv by(simp add:pre_split_face_def)
have "(∃f'∈set(replace f [f⇩2] (faces g)). final f' ∧ (b,a) ∈ ℰ f')"
proof cases
assume "r = u"
then obtain f' where "f' ∈ ℱ g ∧ final f' ∧ (b, a) ∈ ℰ f'"
using abf 1 nf fg by(simp add:one_final_but_def)fast
moreover then have "f' ∈ set (replace f [f⇩2] (faces g))"
by(clarsimp simp: replace6[OF distFg] nf)
ultimately show ?thesis by blast
next
assume nru: "r ≠ u"
note uvr = rotate_before_vFrom[OF distf rf nru ruv]
note bet = before_between[OF uvr distf vinf nrv[symmetric]]
have "(a,b) ∉ Edges (r # ?fru @ [u])"
using abfvr Edges_disj[OF distf vinf uinf nrv[symmetric] nru bet]
by fast
moreover have "(b,a) ∉ Edges (r # ?fru @ [u])"
proof
assume "(b,a) ∈ Edges (r # ?fru @ [u])"
moreover have "pre_split_face f r u []"
by(simp add:pre_split_face_def distf rf uinf nru)
ultimately show False
using minGraphProps12[OF mgp fg abf]
by(blast dest:Edges_between_edges)
qed
ultimately obtain f' where "f' ∈ ℱ g ∧ final f' ∧ (b, a) ∈ ℰ f'"
using abf 1 nf fg nru by(simp add:one_final_but_def)fast
moreover hence "f' ∈ set (replace f [f⇩2] (faces g))"
by(clarsimp simp: replace6[OF distFg] nf)
ultimately show ?thesis by blast
qed
thus ?thesis ..
next
assume f': "f' ∈ ℱ g ∧ f' ≠ f"
moreover
hence "ℰ f' ∩ ℰ f = {}"
using fg by(blast dest: mgp_edges_disj[OF mgp])
moreover
have "Edges_if f r u ⊆ ℰ f"
using distf rf uinf
apply(clarsimp simp del:is_nextElem_edges_eq)
apply(erule Edges_between_edges[where vs = "[]"])
by(simp add:pre_split_face_def)
ultimately
have "(b,a) : Edges_if f r u ∨
(∃f''∈ℱ g. final f'' ∧ (b,a) ∈ ℰ f'')" (is "?A ∨ ?B")
using 1 f' nf' abf'
by(simp add:one_final_but_def split:if_split_asm) blast+
thus ?thesis (is "?A' ∨ ?B'")
proof
assume ?A
moreover
have "Edges_if f r u ⊆ Edges (r # between (vertices f⇩2) r v @ [v])"
using f⇩2rv by (auto simp:Edges_Cons Edges_append)
ultimately have ?A' by blast
thus ?thesis ..
next
assume ?B
then obtain f'' where "f''∈ℱ g ∧ final f'' ∧ (b, a) ∈ ℰ f''"
by blast
moreover hence "f'' ≠ f" using nf by blast
ultimately have ?B' by (blast intro:in_set_repl)
thus ?thesis ..
qed
qed
thus ?case by blast
qed
qed
lemma one_final_but_makeFaceFinal:
"⟦ minGraphProps g; one_final_but g E; E ⊆ ℰ f; f ∈ ℱ g; ¬ final f ⟧ ⟹
one_final (makeFaceFinal f g)"
apply(frule minGraphProps11')
apply(clarsimp simp add:one_final_but_def one_final_def makeFaceFinal_def
makeFaceFinalFaceList_def replace6)
apply(rename_tac f' a b)
apply(erule disjE)
apply(simp)
apply(subgoal_tac "(a,b) ∉ E")
prefer 2 apply (simp add:minGraphProps_def edges_disj_def) apply blast
apply(drule_tac x = f' in bspec)
apply assumption
apply simp
apply(drule_tac x = "(a,b)" in bspec)
apply simp
apply(fastforce simp add: replace6)
done
lemma one_final_subdivFace':
"⋀f v n g.
pre_subdivFace' g f u v n ovs ⟹ minGraphProps g ⟹ f ∈ ℱ g ⟹
one_final_but g (Edges_if f u v) ⟹
one_final(subdivFace' g f v n ovs)"
proof (induct ovs)
case Nil
hence "pre_split_face f u v []"
by(simp add:pre_split_face_def pre_subdivFace'_def)
hence "Edges(u # between (vertices f) u v @ [v]) ⊆ ℰ f"
by(auto simp add:Edges_between_edges)
moreover have "¬ final f" using Nil by(simp add:pre_subdivFace'_def)
ultimately show ?case using Nil by (simp add: one_final_but_makeFaceFinal)
next
case (Cons ov ovs)
note IH = Cons(1) and pre = Cons(2) and mgp = Cons(3) and fg = Cons(4)
note 1 = Cons(5)
have nf: "¬ final f" and uf: "u ∈ 𝒱 f" and vf: "v ∈ 𝒱 f"
using pre by(simp add:pre_subdivFace'_def)+
show ?case
proof (cases ov)
case None
have pre': "pre_subdivFace' g f u v (Suc n) ovs"
using None pre by (simp add: pre_subdivFace'_None)
show ?thesis using None
by (simp add: IH[OF pre' mgp fg 1])
next
case (Some w)
have uw: "u ≠ w" using pre Some by(clarsimp simp: pre_subdivFace'_def)
{ assume w: "f ∙ v = w" and n: "n = 0"
from w minGraphProps3[OF mgp fg]
have vw: "nextElem (vertices f) (hd(vertices f)) v = w"
by(simp add:nextVertex_def)
have 2: "one_final_but g (if u=w then {} else Edges (u # between (vertices f) u w @ [w]))"
apply (rule one_final_but_antimono[OF 1])
using uw apply clarsimp
apply(subgoal_tac "pre_between (vertices f) u v")
prefer 2
using pre vf apply(simp add:pre_subdivFace'_def pre_between_def)
apply(simp add:between_nextElem vw[symmetric])
apply(fastforce simp add:Edges_Cons Edges_append)
done
have pre': "pre_subdivFace' g f u w 0 ovs"
using pre Some n using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
have "one_final (subdivFace' g f w 0 ovs)"
by (simp add: IH[OF pre' mgp fg 2])
} moreover
{ let ?vs = "[countVertices g..<countVertices g + n]"
let ?fdg = "splitFace g v w f ?vs"
let ?Ew = "if u=w then {} else Edges(u # between(vertices (fst(snd ?fdg))) u w @ [w])"
assume a: "f ∙ v = w ⟶ 0 < n"
have pre2: "pre_subdivFace' g f u v n (Some w # ovs)"
using pre Some by simp
have fsubg: "𝒱 f ⊆ 𝒱 g"
using mgp fg by(simp add: minGraphProps_def faces_subset_def)
have pre_fdg: "pre_splitFace g v w f ?vs"
apply (rule pre_subdivFace'_preFaceDiv[OF _ fg _ fsubg])
using Some pre apply simp
using a apply (simp)
done
have bet: "before (verticesFrom f u) v w" using pre Some
by(unfold pre_subdivFace'_def) simp
have 2: "one_final_but(snd(snd ?fdg)) ?Ew"
using uw apply simp
apply(rule FaceDivsionGraph_one_final_but[OF mgp pre_fdg _ uw bet uf 1])
apply(fastforce intro!:prod_eqI)
done
note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
have pre2': "pre_subdivFace' (snd (snd ?fdg)) (fst (snd ?fdg)) u w 0 ovs"
by (rule pre_subdivFace'_Some1[OF pre2 fg _ fsubg HOL.refl HOL.refl])
(simp add:a)
note f2inF = splitFace_add_f21'[OF fg]
have "one_final (subdivFace' (snd (snd ?fdg)) (fst (snd ?fdg)) w 0 ovs)"
by (simp add: IH[OF pre2' mgp' f2inF 2])
} ultimately show ?thesis using Some by (simp add: split_def)
qed
qed
lemma neighbors_edges:
"minGraphProps g ⟹ a : 𝒱 g ⟹ b ∈ set (neighbors g a) = ((a, b) ∈ edges g)"
apply (rule iffI)
apply (simp add: neighbors_def) apply clarify apply (frule (1) minGraphProps5)
apply (simp add: vertices_graph)
apply (simp add: edges_graph_def) apply (intro bexI)
prefer 2 apply assumption
apply(simp add:edges_face_eq)
apply (erule (2) minGraphProps6)
apply (simp add: neighbors_def) apply (simp add: edges_graph_def) apply (elim bexE)
apply (subgoal_tac "x ∈ set (facesAt g a)") apply (simp add: edges_face_def)
apply (rule minGraphProps7) apply simp+ apply (simp add: edges_face_def)
done
lemma no_self_edges: "minGraphProps' g ⟹ (a, a) ∉ edges g" apply (simp add: minGraphProps'_def)
apply (induct g) apply simp apply (simp add: edges_graph_def) apply auto apply (drule bspec) apply assumption
apply auto apply (simp add: is_nextElem_def) apply safe apply (simp add: is_sublist_def) apply force
apply (case_tac "vertices x") apply simp apply (case_tac "list" rule: rev_exhaust) apply simp by simp
text‹Requires only @{prop"distinct(vertices f)"} and that ‹g›
has no self-loops.›
lemma duplicateEdge_is_duplicateEdge_eq:
"minGraphProps g ⟹ f ∈ ℱ g ⟹ a ∈ 𝒱 f ⟹ b ∈ 𝒱 f ⟹
duplicateEdge g f a b = is_duplicateEdge g f a b"
apply (subgoal_tac "distinct (vertices f)")
prefer 2 apply (simp add: minGraphProps3)
apply(subgoal_tac "a : 𝒱 g")
prefer 2 apply (simp add: minGraphProps9)
apply (simp add: duplicateEdge_def is_duplicateEdge_def neighbors_edges)
apply (rule iffI)
apply (simp add: minGraphProps10)
apply (cases "a = b") apply (simp add: no_self_edges minGraphProps_def)
apply (rule ccontr)
apply (simp add: directedLength_def)
apply (case_tac "is_nextElem (vertices f) a b")
apply (simp add: is_nextElem_between_empty)
apply (simp add: is_nextElem_between_empty)
apply (cases "a = b") apply (simp add: no_self_edges minGraphProps_def)
apply (rule ccontr)
apply (simp add: directedLength_def)
apply (elim impE)
apply (cases "between (vertices f) b a")
apply (simp add: is_nextElem_between_empty' del:is_nextElem_between_empty)
apply simp
apply (cases "between (vertices f) a b")
apply (simp add: is_nextElem_between_empty' del:is_nextElem_between_empty)
apply simp
apply (simp add: minGraphProps10)
done
lemma incrIndexList_less_eq:
"incrIndexList ls m nmax ⟹ Suc n < |ls| ⟹ ls!n ≤ ls!Suc n"
apply (subgoal_tac "increasing ls") apply (thin_tac "incrIndexList ls m nmax") apply (rule increasing1) apply simp
apply (subgoal_tac "ls = take n ls @ ls!n # [] @ ls!(Suc n) # drop (Suc (Suc n)) ls") apply assumption
apply simp apply (subgoal_tac "n < | ls|") apply (rotate_tac -1) apply (drule id_take_nth_drop)
apply (subgoal_tac "drop (Suc n) ls = ls ! Suc n # drop (Suc (Suc n)) ls") apply simp apply (drule Cons_nth_drop_Suc)
by auto
lemma incrIndexList_less:
"incrIndexList ls m nmax ⟹ Suc n < |ls| ⟹ ls!n ≠ ls!Suc n⟹ ls!n < ls!Suc n"
apply (drule incrIndexList_less_eq) by auto
lemma Seed_holds_minGraphProps': "minGraphProps' (Seed p)"
by (simp add: graph_def Seed_def minGraphProps'_def)
lemma Seed_holds_facesAt_eq: "facesAt_eq (Seed p)"
by (force simp add: graph_def Seed_def facesAt_eq_def facesAt_def)
lemma minVertex_zero1: "minVertex (Face [0..<Suc z] Final) = 0"
apply (induct z) apply (simp add: minVertex_def)
by (simp add: minVertex_def upt_conv_Cons del: upt_Suc)
lemma minVertex_zero2: "minVertex (Face (rev [0..<Suc z]) Nonfinal) = 0"
apply (induct z) apply (simp add: minVertex_def)
by (simp add: minVertex_def min_def)
subsection‹Invariants of @{const Seed}›
lemma Seed_holds_facesAt_distinct: "facesAt_distinct (Seed p)"
apply(simp add: Seed_def graph_def
facesAt_distinct_def normFaces_def facesAt_def normFace_def)
apply(simp add: eval_nat_numeral minVertex_zero1 minVertex_zero2 verticesFrom_Def
fst_splitAt_upt snd_splitAt_upt fst_splitAt_rev snd_splitAt_rev del:upt_Suc)
apply(simp add:upt_conv_Cons del:upt_Suc)
apply simp
done
lemma Seed_holds_faces_subset: "faces_subset (Seed p)"
by (simp add: Seed_def graph_def faces_subset_def)
lemma Seed_holds_edges_sym: "edges_sym (Seed p)"
by (simp add: Seed_def graph_def edges_sym_def edges_graph_def)
lemma Seed_holds_edges_disj: "edges_disj (Seed p)"
using is_nextElem_circ[of "[0..<(p+3)]"]
by (fastforce simp add: Seed_def graph_def edges_disj_def edges_graph_def)
lemma Seed_holds_faces_distinct: "faces_distinct (Seed p)"
apply(simp add: Seed_def graph_def
faces_distinct_def normFaces_def facesAt_def normFace_def)
apply(simp add: eval_nat_numeral minVertex_zero1 minVertex_zero2 verticesFrom_Def
fst_splitAt_upt snd_splitAt_upt fst_splitAt_rev snd_splitAt_rev del:upt_Suc)
apply(simp add:upt_conv_Cons del:upt_Suc)
apply simp
done
lemma Seed_holds_faceListAt_len: "faceListAt_len (Seed p)"
by (simp add: Seed_def graph_def faceListAt_len_def)
lemma face_face_op_Seed: "face_face_op(Seed p)"
by (simp add: Seed_def graph_def face_face_op_def)
lemma one_final_Seed: "one_final Seed⇘p⇙"
by(clarsimp simp:Seed_def one_final_def one_final_but_def graph_def)
lemma two_face_Seed: "|faces Seed⇘p⇙| ≥ 2"
by(simp add:Seed_def graph_def)
lemma inv_Seed: "inv (Seed p)"
by (simp add: inv_def minGraphProps_def Seed_holds_minGraphProps'
Seed_holds_facesAt_eq Seed_holds_facesAt_distinct Seed_holds_faces_subset
Seed_holds_edges_sym Seed_holds_edges_disj face_face_op_Seed
Seed_holds_faces_distinct Seed_holds_faceListAt_len
one_final_Seed two_face_Seed)
lemma pre_subdivFace_indexToVertexList:
assumes mgp: "minGraphProps g" and f: "f ∈ set (nonFinals g)"
and v: "v ∈ 𝒱 f" and e: "e ∈ set (enumerator i |vertices f| )"
and containsNot: "¬ containsDuplicateEdge g f v e" and i: "2 < i"
shows "pre_subdivFace g f v (indexToVertexList f v e)"
proof -
from e i have le: "|e| = i" by (auto intro: enumerator_length2)
from f have fg: "f ∈ ℱ g" "¬ final f" by (auto simp: nonFinals_def)
with mgp have le_vf: "2 < |vertices f|"
by (simp add: minGraphProps_def minGraphProps'_def)
from fg mgp have dist_f:"distinct (vertices f)"
by (simp add: minGraphProps_def minGraphProps'_def)
with le v i e le_vf fg have "pre_subdivFace_face f v (indexToVertexList f v e)"
by (rule_tac indexToVertexList_pre_subdivFace_face) simp_all
moreover
from dist_f v e le_vf have "indexToVertexList f v e = natToVertexList v f e"
apply (rule_tac indexToVertexList_natToVertexList_eq)
apply simp
apply simp
prefer 2 apply (simp add: enumerator_not_empty)
by (auto simp:set_enumerator_simps intro:enumerator_bound)
moreover
from e le_vf le i have "incrIndexList e i |vertices f|" by simp
moreover note mgp containsNot i dist_f v le
ultimately show ?thesis
apply (simp add: pre_subdivFace_def)
apply (simp add: invalidVertexList_def)
apply (simp add: containsDuplicateEdge_eq containsDuplicateEdge'_def)
apply (rule allI) apply(rename_tac j) apply (rule impI)
apply (case_tac "natToVertexList v f e ! j") apply simp
apply simp
apply (case_tac "natToVertexList v f e ! Suc j") apply simp
apply simp
apply (case_tac "j") apply (simp add: natToVertexList_nth_0 natToVertexList_nth_Suc split: if_split_asm)
apply (drule_tac spec) apply (rotate_tac -1) apply (erule impE)
apply (subgoal_tac "e ! 0 < e ! Suc 0") apply assumption
apply (cases "e") apply simp
apply simp
apply (drule incrIndexList_help21)
apply simp
apply (subgoal_tac "f⇗e ! 0⇖ ∙ v ∈ 𝒱 f")
apply (subgoal_tac "f⇗e ! Suc 0⇖ ∙ v ∈ 𝒱 f")
apply (simp add: duplicateEdge_is_duplicateEdge_eq [symmetric] fg)
apply (rule ccontr)
apply simp
apply (cases e) apply simp
apply simp
apply (drule incrIndexList_help21) apply clarify apply (drule not_sym) apply (rotate_tac -2) apply simp
apply (rule nextVertices_in_face) apply simp
apply (rule nextVertices_in_face) apply simp
apply simp
apply (subgoal_tac "natToVertexList v f e ! Suc nat =
(if e ! nat = e ! Suc nat then None else Some (f⇗e ! Suc nat⇖ ∙ v))")
apply (simp split: if_split_asm)
apply (subgoal_tac "natToVertexList v f e ! Suc (Suc nat) =
(if e ! (Suc nat) = e ! Suc (Suc nat) then None else Some (f⇗e ! Suc (Suc nat)⇖ ∙ v))")
apply (simp split: if_split_asm)
apply (drule spec) apply (rotate_tac -1) apply (erule impE)
apply (subgoal_tac "e ! nat < e ! Suc nat") apply assumption
apply (rule incrIndexList_less) apply assumption apply arith
apply simp
apply simp
apply (subgoal_tac "f⇗e ! Suc nat⇖ ∙ v ∈ 𝒱 f")
apply (subgoal_tac "f⇗e ! Suc (Suc nat)⇖ ∙ v ∈ 𝒱 f")
apply (simp add: duplicateEdge_is_duplicateEdge_eq [symmetric] fg)
apply (rule ccontr) apply simp
apply (rotate_tac -4) apply (erule impE) apply arith
apply (subgoal_tac "e ! Suc nat < e ! Suc (Suc nat)") apply force
apply (rule incrIndexList_less) apply assumption apply arith
apply simp
apply (rule nextVertices_in_face) apply simp
apply (rule nextVertices_in_face) apply simp
apply (rule natToVertexList_nth_Suc) apply simp apply arith
apply (rule natToVertexList_nth_Suc) apply simp by arith
qed
subsection‹Increasing properties of @{const subdivFace'}›
lemma subdivFace'_incr:
assumes Ptrans: "⋀x y z. Q x y ⟹ P y z ⟹ P x z"
and mkFin: "⋀f g. f ∈ ℱ g ⟹ ¬ final f ⟹ P g (makeFaceFinal f g)"
and fdg_incr: "⋀g u v f vs.
pre_splitFace g u v f vs ⟹
Q g (snd(snd(splitFace g u v f vs)))"
shows
"⋀f' v n g. pre_subdivFace' g f' v' v n ovl ⟹
minGraphProps g ⟹ f' ∈ ℱ g ⟹ P g (subdivFace' g f' v n ovl)"
proof (induct ovl)
case Nil thus ?case by (simp add: pre_subdivFace'_def mkFin)
next
case (Cons ov ovl) then show ?case
apply simp
apply (cases "ov")
apply (simp)
apply (rule Cons)
apply (rule pre_subdivFace'_None)
apply assumption+
apply simp
apply (intro conjI)
apply rule
apply simp
apply (rule Cons)
apply (rule pre_subdivFace'_Some2)
apply assumption+
apply (rule)
apply (simp add: split_def)
apply(rule Ptrans)
prefer 2
apply (rule Cons)
apply (erule (1) pre_subdivFace'_Some1[OF _ _ _ _ HOL.refl HOL.refl])
apply simp
apply (simp add: minGraphProps_def faces_subset_def)
apply (rule splitFace_holds_minGraphProps)
apply (erule (1) pre_subdivFace'_preFaceDiv)
apply simp
apply(simp add: minGraphProps_def faces_subset_def)
apply assumption
apply (erule splitFace_add_f21')
apply(rule fdg_incr)
apply(erule (1) pre_subdivFace'_preFaceDiv)
apply simp
apply(simp add: minGraphProps_def faces_subset_def)
done
qed
lemma next_plane0_via_subdivFace':
assumes mgp: "minGraphProps g" and gg': "g [next_plane0⇘p⇙]→ g'"
and P: "⋀f v' v n g ovs. minGraphProps g ⟹ pre_subdivFace' g f v' v n ovs ⟹
f ∈ ℱ g ⟹ P g (subdivFace' g f v n ovs)"
shows "P g g'"
proof -
from gg'
obtain f v i "is" e where g': "g' = subdivFace g f is"
and f: "f ∈ set (nonFinals g)" and v: "v ∈ 𝒱 f"
and e: "e ∈ set (enumerator i |vertices f| )" and i: "2 < i"
and containsNot: "¬ containsDuplicateEdge g f v e"
and is_eq: "is = indexToVertexList f v e"
by (auto simp: next_plane0_def generatePolygon_def image_def split:if_split_asm)
from f have fg: "f ∈ ℱ g" by(simp add:nonFinals_def)
note pre_add = pre_subdivFace_indexToVertexList[OF mgp f v e containsNot i]
with g' is_eq have g': "g' = subdivFace' g f v 0 (tl is)"
by (simp add: subdivFace_subdivFace'_eq)
from pre_add is_eq have "is ≠ []"
by (simp add: pre_subdivFace_def pre_subdivFace_face_def)
with pre_add v is_eq
have "pre_subdivFace' g f v v 0 (tl is)"
by(fastforce simp add:neq_Nil_conv elim:pre_subdivFace_pre_subdivFace')
from P[OF mgp this fg] g' show ?thesis by simp
qed
lemma next_plane0_incr:
assumes Ptrans: "⋀x y z. Q x y ⟹ P y z ⟹ P x z"
and mkFin: "⋀f g. f ∈ ℱ g ⟹ ¬ final f ⟹ P g (makeFaceFinal f g)"
and fdg_incr: "⋀g u v f vs.
pre_splitFace g u v f vs ⟹
Q g (snd(snd(splitFace g u v f vs)))"
and mgp: "minGraphProps g" and gg': "g [next_plane0⇘p⇙]→ g'"
shows "P g g'"
apply(rule next_plane0_via_subdivFace'[OF mgp gg'])
apply(rule subdivFace'_incr)
apply(erule (1) Ptrans)
apply(erule (1) mkFin)
apply(erule fdg_incr)
apply assumption+
done
subsubsection‹Increasing number of faces›
lemma splitFace_incr_faces:
"pre_splitFace g u v f vs ⟹
finals(snd(snd(splitFace g u v f vs))) = finals g ∧
|nonFinals(snd(snd(splitFace g u v f vs)))| = Suc |nonFinals g|"
apply(unfold pre_splitFace_def)
apply(simp add: splitFace_def split_def finals_def nonFinals_def
split_face_def filter_replace2 length_filter_replace2)
done
lemma subdivFace'_incr_faces:
"pre_subdivFace' g f u v n ovs ⟹
minGraphProps g ⟹ f ∈ ℱ g ⟹
|finals (subdivFace' g f v n ovs)| = Suc |finals g| ∧
|nonFinals(subdivFace' g f v n ovs)| ≥ |nonFinals g| - Suc 0"
apply(rule subdivFace'_incr)
prefer 4 apply assumption
prefer 4 apply assumption
prefer 4 apply assumption
prefer 2
apply(simp add: pre_subdivFace'_def len_finals_makeFaceFinal
len_nonFinals_makeFaceFinal)
prefer 2
apply(erule splitFace_incr_faces)
apply (rule conjI)
apply simp
apply arith
done
lemma next_plane0_incr_faces:
"minGraphProps g ⟹ g [next_plane0⇘p⇙]→ g' ⟹
|finals g'| = |finals g|+1 ∧ |nonFinals g'| ≥ |nonFinals g| - 1"
apply simp
apply(rule next_plane0_incr)
prefer 4 apply assumption
prefer 4 apply assumption
prefer 2
apply(simp add: pre_subdivFace'_def len_finals_makeFaceFinal
len_nonFinals_makeFaceFinal)
prefer 2
apply(erule splitFace_incr_faces)
apply (rule conjI)
apply simp
apply arith
done
lemma two_faces_subdivFace':
"pre_subdivFace' g f u v n ovs ⟹ minGraphProps g ⟹ f ∈ ℱ g ⟹
|faces g| ≥ 2 ⟹ |faces(subdivFace' g f v n ovs)| ≥ 2"
apply(drule (2) subdivFace'_incr_faces)
using len_faces_sum[of g] len_faces_sum[of "subdivFace' g f v n ovs"] by arith
subsection‹Main invariant theorems›
lemma inv_genPoly:
assumes inv: "inv g" and polygen: "g' ∈ set(generatePolygon i v f g)"
and f: "f ∈ set (nonFinals g)" and i: "2 < i" and v: "v ∈ 𝒱 f"
shows "inv g'"
proof(unfold inv_def)
have mgp: "minGraphProps g" and 1: "one_final g"
using inv by(simp add:inv_def)+
from polygen
obtain "is" e where g': "g' = subdivFace g f is"
and e: "e ∈ set (enumerator i |vertices f| )"
and containsNot: "¬ containsDuplicateEdge g f v e"
and is_eq: "is = indexToVertexList f v e"
by (auto simp: generatePolygon_def)
have f': "f ∈ ℱ g" using f by(simp add:nonFinals_def)
note pre_add = pre_subdivFace_indexToVertexList[OF mgp f v e containsNot i]
with g' is_eq have g': "g' = subdivFace' g f v 0 (tl is)"
by (simp add: subdivFace_subdivFace'_eq)
from pre_add is_eq have i_nz: "is ≠ []"
by (simp add: pre_subdivFace_def pre_subdivFace_face_def)
with pre_add v i_nz is_eq
have pre_addSnd: "pre_subdivFace' g f v v 0 (tl is)"
by(fastforce simp add:neq_Nil_conv elim:pre_subdivFace_pre_subdivFace')
note 2 = one_final_antimono[OF 1]
show "minGraphProps g' ∧ one_final g' ∧ |faces g'| ≥ 2"
proof auto
show "minGraphProps g'" using g' pre_addSnd f
apply (simp add:nonFinals_def)
apply (rule subdivFace'_holds_minGraphProps[OF _ _ mgp])
by (simp_all add: succs)
next
show "one_final g'" using g' 1
by (simp add: one_final_subdivFace'[OF pre_addSnd mgp f' 2])
next
show "|faces g'| ≥ 2" using g'
by (simp add: two_faces_subdivFace'[OF pre_addSnd mgp f' inv_two_faces[OF inv]])
qed
qed
lemma inv_inv_next_plane0: "invariant inv next_plane0⇘p⇙"
proof(clarsimp simp:invariant_def)
fix g g'
assume inv: "inv g" and "g' ∈ set (next_plane0⇘p⇙ g)"
then obtain i v f where "g' ∈ set(generatePolygon i v f g)"
and "f ∈ set (nonFinals g)" and "2 < i" and "v ∈ 𝒱 f"
by (auto simp: next_plane0_def split: if_split_asm)
thus "inv g'" using inv by(blast intro:inv_genPoly)
qed
end
Theory PlaneProps
section "Further Plane Graph Properties"
theory PlaneProps
imports Invariants
begin
subsection ‹@{const final}›
lemma plane_final_facesAt:
assumes "inv g" "final g" "v : 𝒱 g" "f ∈ set (facesAt g v)" shows "final f"
proof -
from assms(1,3,4) have "f ∈ ℱ g" by(blast intro: minGraphProps inv_mgp)
with assms(2) show ?thesis by (rule finalGraph_face)
qed
lemma finalVertexI:
"⟦ inv g; final g; v ∈ 𝒱 g ⟧ ⟹ finalVertex g v"
by (auto simp add: finalVertex_def nonFinals_def filter_empty_conv plane_final_facesAt)
lemma setFinal_notin_finals:
"⟦ f ∈ ℱ g; ¬ final f; minGraphProps g ⟧ ⟹ setFinal f ∉ set (finals g)"
apply(drule minGraphProps11)
apply(cases f)
apply(fastforce simp:finals_def setFinal_def normFaces_def normFace_def
verticesFrom_def minVertex_def inj_on_def distinct_map
split:facetype.splits)
done
subsection ‹@{const degree}›
lemma planeN4: "inv g ⟹ f ∈ ℱ g ⟹ 3 ≤ |vertices f|"
apply(subgoal_tac "2 < | vertices f |")
apply arith
apply(drule inv_mgp)
apply (erule (1) minGraphProps2)
done
lemma degree_eq:
assumes pl: "inv g" and fin: "final g" and v: "v : 𝒱 g"
shows "degree g v = tri g v + quad g v + except g v"
proof -
have dist: "distinct(facesAt g v)" using pl v by simp
have 3: "∀f ∈ set(facesAt g v). |vertices f| = 3 ∨ |vertices f| = 4 ∨
|vertices f| ≥ 5"
proof
fix f assume f: "f ∈ set (facesAt g v)"
hence "|vertices f| ≥ 3"
using minGraphProps5[OF inv_mgp[OF pl] v f] planeN4[OF pl] by blast
thus "|vertices f| = 3 ∨ |vertices f| = 4 ∨ |vertices f| ≥ 5" by arith
qed
have "degree g v = |facesAt g v|" by(simp add:degree_def)
also have "… = card(set(facesAt g v))" by (simp add:distinct_card[OF dist])
also have "set(facesAt g v) = {f ∈ set(facesAt g v). |vertices f| = 3} ∪
{f ∈ set(facesAt g v). |vertices f| = 4} ∪
{f ∈ set(facesAt g v). |vertices f| ≥ 5}"
(is "_ = ?T ∪ ?Q ∪ ?E")
using 3 by blast
also have "card(?T ∪ ?Q ∪ ?E) = card ?T + card ?Q + card ?E"
apply (subst card_Un_disjoint)
apply simp
apply simp
apply fastforce
apply (subst card_Un_disjoint)
apply simp
apply simp
apply fastforce
apply simp
done
also have "… = tri g v + quad g v + except g v" using fin
by(simp add:tri_def quad_def except_def
distinct_card[symmetric] distinct_filter[OF dist]
plane_final_facesAt[OF pl fin v] cong:conj_cong)
finally show ?thesis .
qed
lemma plane_fin_exceptionalVertex_def:
assumes pl: "inv g" and fin: "final g" and v: "v : 𝒱 g"
shows "exceptionalVertex g v =
( | [f ← facesAt g v . 5 ≤ |vertices f| ] | ≠ 0)"
proof -
have "⋀f. f ∈ set (facesAt g v) ⟹ final f"
by(rule plane_final_facesAt[OF pl fin v])
then show ?thesis by (simp add: filter_simp exceptionalVertex_def except_def)
qed
lemma not_exceptional:
"inv g ⟹ final g ⟹ v : 𝒱 g ⟹ f ∈ set (facesAt g v) ⟹
¬ exceptionalVertex g v ⟹ |vertices f| ≤ 4"
by (auto simp add: plane_fin_exceptionalVertex_def except_def filter_empty_conv)
subsection ‹Misc›
lemma in_next_plane0I:
assumes "g' ∈ set (generatePolygon n v f g)" "f ∈ set (nonFinals g)"
"v ∈ 𝒱 f" "3 ≤ n" "n < 4+p"
shows "g' ∈ set (next_plane0⇘p⇙ g)"
proof -
from assms have
"∃n∈{3..<4 + p}. g' ∈ set (generatePolygon n v f g)"
by auto
with assms have
"∃v∈𝒱 f. ∃n∈{3..<4 + p}. g' ∈ set (generatePolygon n v f g)"
by auto
with assms have
"∃f∈set (nonFinals g). ∃v∈𝒱 f. ∃n∈{3..<4 + p}. g' ∈ set (generatePolygon n v f g)"
by auto
moreover have "¬ final g" using assms(2)
by (auto simp: nonFinals_def finalGraph_def filter_empty_conv)
ultimately show ?thesis
by (simp add: next_plane0_def)
qed
lemma next_plane0_nonfinals: "g [next_plane0⇘p⇙]→ g' ⟹ nonFinals g ≠ []"
by(auto simp:next_plane0_def finalGraph_def)
lemma next_plane0_ex:
assumes a: "g [next_plane0⇘p⇙]→ g'"
shows "∃f∈ set(nonFinals g). ∃v ∈ 𝒱 f. ∃i ∈ set([3..<Suc(maxGon p)]).
g' ∈ set (generatePolygon i v f g)"
proof -
from a have "¬ final g" by (auto simp add: next_plane0_def)
with a show ?thesis
by (auto simp add: next_plane0_def nonFinals_def)
qed
lemma step_outside2:
"inv g ⟹ g [next_plane0⇘p⇙]→ g' ⟹ ¬ final g' ⟹ |faces g'| ≠ 2"
apply(frule inv_two_faces)
apply(frule inv_finals_nonempty)
apply(drule inv_mgp)
apply(insert len_faces_sum[of g] len_faces_sum[of g'])
apply(subgoal_tac "|nonFinals g| ≠ 0")
prefer 2 apply(drule next_plane0_nonfinals) apply simp
apply(subgoal_tac "|nonFinals g'| ≠ 0")
prefer 2 apply(simp add:finalGraph_def)
apply(drule (1) next_plane0_incr_faces)
apply(case_tac "|faces g| = 2")
prefer 2 apply arith
apply(subgoal_tac "|finals g| ≠ 0")
apply arith
apply simp
done
subsection‹Increasing final faces›
lemma set_finals_splitFace[simp]:
"⟦ f ∈ ℱ g; ¬ final f ⟧ ⟹
set(finals(snd(snd(splitFace g u v f vs)))) = set(finals g)"
apply(auto simp add:splitFace_def split_def finals_def
split_face_def)
apply(drule replace5)
apply(clarsimp)
apply(erule replace4)
apply clarsimp
done
lemma next_plane0_finals_incr:
"g [next_plane0⇘p⇙]→ g' ⟹ f ∈ set(finals g) ⟹ f ∈ set(finals g')"
apply(auto simp:next_plane0_def generatePolygon_def split:if_split_asm)
apply(erule subdivFace_pres_finals)
apply (simp add:nonFinals_def)
done
lemma next_plane0_finals_subset:
"g' ∈ set (next_plane0⇘p⇙ g) ⟹
set (finals g) ⊆ set (finals g')"
by (auto simp add: next_plane0_finals_incr)
lemma next_plane0_final_mono:
"⟦ g' ∈ set (next_plane0⇘p⇙ g); f ∈ ℱ g; final f ⟧ ⟹ f ∈ ℱ g'"
apply(drule next_plane0_finals_subset)
apply(simp add:finals_def)
apply blast
done
subsection‹Increasing vertices›
lemma next_plane0_vertices_subset:
"⟦ g' ∈ set (next_plane0⇘p⇙ g); minGraphProps g ⟧ ⟹ 𝒱 g ⊆ 𝒱 g'"
apply(rule next_plane0_incr)
apply(erule (1) subset_trans)
apply(simp add: vertices_makeFaceFinal)
defer apply assumption+
apply (auto simp: splitFace_def split_def vertices_graph)
done
subsection‹Increasing vertex degrees›
lemma next_plane0_incr_faceListAt:
"⟦ g' ∈ set (next_plane0⇘p⇙ g); minGraphProps g ⟧
⟹ |faceListAt g| ≤ |faceListAt g'| ∧
(∀v < |faceListAt g|. |faceListAt g ! v| ≤ |faceListAt g' ! v| )"
(is "_ ⟹ _ ⟹ ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q])
prefer 4 apply assumption
prefer 4 apply assumption
apply(rule conjI) apply fastforce
apply(clarsimp)
apply(erule allE, erule impE, assumption)
apply(erule_tac x = v in allE, erule impE) apply force
apply force
apply(simp add: makeFaceFinal_def makeFaceFinalFaceList_def)
apply (simp add: splitFace_def split_def nth_append nth_list_update)
done
lemma next_plane0_incr_degree:
"⟦ g' ∈ set (next_plane0⇘p⇙ g); minGraphProps g; v ∈ 𝒱 g ⟧
⟹ degree g v ≤ degree g' v"
apply(frule (1) next_plane0_incr_faceListAt)
apply(frule (1) next_plane0_vertices_subset)
apply(simp add:degree_def facesAt_def)
apply(frule minGraphProps4)
apply(simp add:vertices_graph)
done
subsection‹Increasing @{const except}›
lemma next_plane0_incr_except:
assumes "g' ∈ set (next_plane0⇘p⇙ g)" "inv g" "v ∈ 𝒱 g"
shows "except g v ≤ except g' v"
proof (unfold except_def)
note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp ‹v : 𝒱 g›]]
have "v ∈ 𝒱 g'"
using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' ‹v : 𝒱 g'›]]
have "|[f←facesAt g v . final f ∧ 5 ≤ |vertices f| ]| =
card{f∈ set(facesAt g v) . final f ∧ 5 ≤ |vertices f|}"
(is "?L = card ?M") using distinct_card[OF dist] by simp
also have "?M = {f∈ ℱ g. v ∈ 𝒱 f ∧ final f ∧ 5 ≤ |vertices f|}"
by(simp add: minGraphProps_facesAt_eq[OF mgp assms(3)])
also have "… = {f ∈ set(finals g) . v ∈ 𝒱 f ∧ 5 ≤ |vertices f|}"
by(auto simp:finals_def)
also have "card … ≤ card{f ∈ set(finals g'). v ∈ 𝒱 f ∧ 5 ≤ |vertices f|}"
(is "_ ≤ card ?M")
apply(rule card_mono)
apply simp
using next_plane0_finals_subset[OF assms(1)] by blast
also have "?M = {f∈ ℱ g' . v ∈ 𝒱 f ∧ final f ∧ 5 ≤ |vertices f|}"
by(auto simp:finals_def)
also have "… = {f ∈ set(facesAt g' v) . final f ∧ 5 ≤ |vertices f|}"
by(simp add: minGraphProps_facesAt_eq[OF mgp' ‹v ∈ 𝒱 g'›])
also have "card … =
|[f ← facesAt g' v . final f ∧ 5 ≤ |vertices f| ]|" (is "_ = ?R")
using distinct_card[OF dist'] by simp
finally show "?L ≤ ?R" .
qed
subsection‹Increasing edges›
lemma next_plane0_set_edges_subset:
"⟦ minGraphProps g; g [next_plane0⇘p⇙]→ g' ⟧ ⟹ edges g ⊆ edges g'"
apply(rule next_plane0_incr)
apply(erule (1) subset_trans)
apply(simp add: edges_makeFaceFinal)
apply(erule snd_snd_splitFace_edges_incr)
apply assumption+
done
subsection‹Increasing final vertices›
declare atLeastLessThan_iff[iff]
lemma next_plane0_incr_finV:
"⟦g' ∈ set (next_plane0⇘p⇙ g); minGraphProps g ⟧
⟹ ∀v ∈ 𝒱 g. v ∈ 𝒱 g' ∧
((∀f∈ℱ g. v ∈ 𝒱 f ⟶ final f) ⟶
(∀f∈ℱ g'. v ∈ 𝒱 f ⟶ f ∈ ℱ g))" (is "_ ⟹ _ ⟹ ?Q g g'")
apply(rule next_plane0_incr[where Q = ?Q and g=g and g'=g'])
prefer 4 apply assumption
prefer 4 apply assumption
apply fast
apply(clarsimp simp:makeFaceFinal_def vertices_graph makeFaceFinalFaceList_def)
apply(drule replace5)
apply(erule disjE)apply blast
apply(simp add:setFinal_def)
apply(unfold pre_splitFace_def)
apply(clarsimp simp:splitFace_def split_def vertices_graph)
apply(rule conjI)
apply(clarsimp simp:split_face_def vertices_graph atLeastLessThan_def)
apply(blast dest:inbetween_inset)
apply(clarsimp)
apply(erule disjE[OF replace5]) apply blast
apply(clarsimp simp:split_face_def vertices_graph)
apply(blast dest:inbetween_inset)
done
lemma next_plane0_finalVertex_mono:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g; u ∈ 𝒱 g; finalVertex g u ⟧
⟹ finalVertex g' u"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "u ∈ 𝒱 g'")
prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
apply(blast dest:next_plane0_incr_finV inv_mgp)
done
subsection‹Preservation of @{const facesAt} at final vertices›
lemma next_plane0_finalVertex_facesAt_eq:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g; v ∈ 𝒱 g; finalVertex g v ⟧
⟹ set(facesAt g' v) = set(facesAt g v)"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(subgoal_tac "v ∈ 𝒱 g'")
prefer 2 apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply(clarsimp simp:finalVertex_def minGraphProps_facesAt_eq[OF inv_mgp])
by(blast dest:next_plane0_incr_finV next_plane0_final_mono inv_mgp)
lemma next_plane0_len_filter_eq:
assumes "g' ∈ set (next_plane0⇘p⇙ g)" "inv g" "v ∈ 𝒱 g" "finalVertex g v"
shows "|filter P (facesAt g' v)| = |filter P (facesAt g v)|"
proof -
note inv' = invariantE[OF inv_inv_next_plane0, OF assms(1,2)]
note mgp = inv_mgp[OF assms(2)] and mgp' = inv_mgp[OF inv']
note dist = distinct_filter[OF mgp_dist_facesAt[OF mgp ‹v : 𝒱 g›]]
have "v ∈ 𝒱 g'"
using assms(3) next_plane0_vertices_subset[OF assms(1) mgp] by blast
note dist' = distinct_filter[OF mgp_dist_facesAt[OF mgp' ‹v : 𝒱 g'›]]
have "|filter P (facesAt g' v)| = card{f ∈ set(facesAt g' v) . P f}"
using distinct_card[OF dist'] by simp
also have "… = card{f ∈ set(facesAt g v) . P f}"
by(simp add: next_plane0_finalVertex_facesAt_eq[OF assms])
also have "… = |filter P (facesAt g v)|"
using distinct_card[OF dist] by simp
finally show ?thesis .
qed
subsection‹Properties of @{const subdivFace'}›
lemma new_edge_subdivFace':
"⋀f v n g.
pre_subdivFace' g f u v n ovs ⟹ minGraphProps g ⟹ f ∈ ℱ g ⟹
subdivFace' g f v n ovs = makeFaceFinal f g ∨
(∀f' ∈ ℱ (subdivFace' g f v n ovs) - (ℱ g - {f}).
∃e ∈ ℰ f'. e ∉ ℰ g)"
proof (induct ovs)
case Nil thus ?case by simp
next
case (Cons ov ovs)
note IH = Cons(1) and pre = Cons(2) and mgp = Cons(3) and fg = Cons(4)
have uf: "u ∈ 𝒱 f" and vf: "v ∈ 𝒱 f" and distf: "distinct (vertices f)"
using pre by(simp add:pre_subdivFace'_def)+
note distFg = minGraphProps11'[OF mgp]
show ?case
proof (cases ov)
case None
have pre': "pre_subdivFace' g f u v (Suc n) ovs"
using None pre by (simp add: pre_subdivFace'_None)
show ?thesis using None
by (simp add: IH[OF pre' mgp fg])
next
case (Some w)
note pre = pre[simplified Some]
have uvw: "before (verticesFrom f u) v w"
using pre by(simp add:pre_subdivFace'_def)
have uw: "u ≠ w" using pre by(clarsimp simp: pre_subdivFace'_def)
{ assume w: "f ∙ v = w" and n: "n = 0"
have pre': "pre_subdivFace' g f u w 0 ovs"
using pre Some n using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
note IH[OF pre' mgp fg]
} moreover
{ let ?vs = "[countVertices g..<countVertices g + n]"
let ?fdg = "splitFace g v w f ?vs"
let ?f⇩1 = "fst ?fdg" and ?f⇩2 = "fst(snd ?fdg)" and ?g' = "snd(snd ?fdg)"
let ?g'' = "subdivFace' ?g' ?f⇩2 w 0 ovs"
let ?fvw = "between(vertices f) v w" and ?fwv = "between(vertices f) w v"
assume a: "f ∙ v = w ⟶ 0 < n"
have fsubg: "𝒱 f ⊆ 𝒱 g"
using mgp fg by(simp add: minGraphProps_def faces_subset_def)
have pre_fdg: "pre_splitFace g v w f ?vs"
apply (rule pre_subdivFace'_preFaceDiv[OF pre fg _ fsubg])
using a by (simp)
hence "v ≠ w" and "w ∈ 𝒱 f" by(unfold pre_splitFace_def)simp+
have f⇩1: "?f⇩1= fst(split_face f v w ?vs)"
and f⇩2: "?f⇩2 = snd(split_face f v w ?vs)"
by(auto simp add:splitFace_def split_def)
note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
have E⇩1: "ℰ ?f⇩1 = Edges (w # rev ?vs @ [v]) ∪ Edges (v # ?fvw @ [w])"
using f⇩1 by(simp add:edges_split_face1[OF pre_split])
have E⇩2: "ℰ ?f⇩2 = Edges (v # ?vs @ [w]) ∪ Edges (w # ?fwv @ [v])"
by(simp add:splitFace_def split_def
edges_split_face2[OF pre_split])
note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
note distFg' = minGraphProps11'[OF mgp']
have pre': "pre_subdivFace' ?g' ?f⇩2 u w 0 ovs"
by (rule pre_subdivFace'_Some1[OF pre fg _ fsubg HOL.refl HOL.refl])
(simp add:a)
note f2inF = splitFace_add_f21'[OF fg]
have 1: "∃e ∈ ℰ ?f⇩1. e ∉ ℰ g"
proof cases
assume "rev ?vs = []"
hence "(w,v) ∈ ℰ ?f⇩1 ∧ (w,v) ∉ ℰ g" using pre_fdg E⇩1
by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
thus ?thesis by blast
next
assume "rev ?vs ≠ []"
then obtain x xs where rvs: "rev ?vs = x#xs"
by(auto simp only:neq_Nil_conv)
hence "(w,x) ∈ ℰ ?f⇩1" using E⇩1 by (auto simp:Edges_Cons)
moreover have "(w,x) ∉ ℰ g"
proof -
have "x ∈ set(rev ?vs)" using rvs by simp
hence "x ≥ countVertices g" by simp
hence "x ∉ 𝒱 g" by(induct g) (simp add:vertices_graph_def)
thus ?thesis
by (auto simp:edges_graph_def)
(blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
qed
ultimately show ?thesis by blast
qed
have 2: "∃e ∈ ℰ ?f⇩2. e ∉ ℰ g"
proof cases
assume "?vs = []"
hence "(v,w) ∈ ℰ ?f⇩2 ∧ (v,w) ∉ ℰ g" using pre_fdg E⇩2
by(unfold pre_splitFace_def) (auto simp:Edges_Cons)
thus ?thesis by blast
next
assume "?vs ≠ []"
then obtain x xs where vs: "?vs = x#xs"
by(auto simp only:neq_Nil_conv)
hence "(v,x) ∈ ℰ ?f⇩2" using E⇩2 by (auto simp:Edges_Cons)
moreover have "(v,x) ∉ ℰ g"
proof -
have "x ∈ set ?vs" using vs by simp
hence "x ≥ countVertices g" by simp
hence "x ∉ 𝒱 g" by(induct g) (simp add:vertices_graph_def)
thus ?thesis
by (auto simp:edges_graph_def)
(blast dest: in_edges_in_vertices minGraphProps9[OF mgp])
qed
ultimately show ?thesis by blast
qed
have fdg: "(?f⇩1,?f⇩2,?g') = splitFace g v w f ?vs" by auto
hence Fg': "ℱ ?g' = {?f⇩1,?f⇩2} ∪ (ℱ g - {f})"
using set_faces_splitFace[OF mgp fg pre_fdg] by blast
have "∀f' ∈ ℱ ?g'' - (ℱ g - {f}). ∃e ∈ ℰ f'. e ∉ ℰ g"
proof (clarify)
fix f' assume f'g'': "f' ∈ ℱ ?g''" and f'ng: "f' ∉ ℱ g - {f}"
from IH[OF pre' mgp' f2inF]
show "∃e ∈ ℰ f'. e ∉ ℰ g"
proof
assume "?g'' = makeFaceFinal ?f⇩2 ?g'"
hence "f' = setFinal ?f⇩2 ∨ f' = ?f⇩1" (is "?A ∨ ?B")
using f'g'' Fg' f'ng
by(auto simp:makeFaceFinal_def makeFaceFinalFaceList_def
distinct_set_replace[OF distFg'])
thus ?thesis
proof
assume ?A thus ?thesis using 2 by(simp)
next
assume ?B thus ?thesis using 1 by blast
qed
next
assume A: "∀f' ∈ ℱ ?g'' - (ℱ ?g' - {?f⇩2}).
∃e ∈ ℰ f'. e ∉ ℰ ?g'"
show ?thesis
proof cases
assume "f' ∈ {?f⇩1,?f⇩2}"
thus ?thesis using 1 2 by blast
next
assume "f' ∉ {?f⇩1,?f⇩2}"
hence "∃e∈ℰ f'. e ∉ ℰ ?g'"
using A f'g'' f'ng Fg' by simp
with splitFace_edges_incr[OF pre_fdg fdg]
show ?thesis by blast
qed
qed
qed
}
ultimately show ?thesis using Some by(auto simp: split_def)
qed
qed
lemma dist_edges_subdivFace':
"pre_subdivFace' g f u v n ovs ⟹ minGraphProps g ⟹ f ∈ ℱ g ⟹
subdivFace' g f v n ovs = makeFaceFinal f g ∨
(∀f' ∈ ℱ (subdivFace' g f v n ovs) - (ℱ g - {f}). ℰ f' ≠ ℰ f)"
apply(drule (2) new_edge_subdivFace')
apply(erule disjE)
apply blast
apply(rule disjI2)
apply(clarify)
apply(drule bspec)
apply fast
apply(simp add:edges_graph_def)
by(blast)
lemma between_last: "⟦ distinct(vertices f); u ∈ 𝒱 f ⟧ ⟹
between (vertices f) u (last (verticesFrom f u)) =
butlast(tl(verticesFrom f u))"
apply(drule split_list)
apply (fastforce dest: last_in_set
simp: between_def verticesFrom_Def split_def
last_append butlast_append fst_splitAt_last)
done
lemma final_subdivFace': "⋀f u n g. minGraphProps g ⟹
pre_subdivFace' g f r u n ovs ⟹ f ∈ ℱ g ⟹
(ovs = [] ⟶ n=0 ∧ u = last(verticesFrom f r)) ⟹
∃f' ∈ set(finals(subdivFace' g f u n ovs)) - set(finals g).
(f⇗-1⇖ ∙ r,r) ∈ ℰ f' ∧ |vertices f'| =
n + |ovs| + (if r=u then 1 else |between (vertices f) r u| + 2)"
proof (induct ovs)
case Nil show ?case (is "∃f' ∈ ?F. ?P f'")
proof
show "?P (setFinal f)" (is "?A ∧ ?B")
proof
show "?A" using Nil
by(simp add:pre_subdivFace'_def prevVertex_in_edges
del:is_nextElem_edges_eq)
show "?B"
using Nil mgp_vertices3[OF Nil(1,3)]
by(simp add: setFinal_def between_last pre_subdivFace'_def)
qed
next
show "setFinal f ∈ ?F" using Nil
by(simp add:pre_subdivFace'_def setFinal_notin_finals minGraphProps11')
qed
next
case (Cons ov ovs)
note IH = Cons(1) and mgp = Cons(2) and pre = Cons(3) and fg = Cons(4)
and mt = Cons(5)
have "r ∈ 𝒱 f" and "u ∈ 𝒱 f" and distf: "distinct (vertices f)"
using pre by(simp add:pre_subdivFace'_def)+
show ?case
proof (cases ov)
case None
have pre': "pre_subdivFace' g f r u (Suc n) ovs"
using None pre by (simp add: pre_subdivFace'_None)
have "ovs ≠ []" using pre None by (auto simp: pre_subdivFace'_def)
thus ?thesis using None IH[OF mgp pre' fg] by simp
next
case (Some v)
note pre = pre[simplified Some]
have ruv: "before (verticesFrom f r) u v" and "r ≠ v"
using pre by(simp add:pre_subdivFace'_def)+
show ?thesis
proof (cases "f ∙ u = v ∧ n = 0")
case True
have pre': "pre_subdivFace' g f r v 0 ovs"
using pre True using [[simp_depth_limit = 5]] by (simp add: pre_subdivFace'_Some2)
have mt: "ovs = [] ⟶ 0 = 0 ∧ v = last (verticesFrom f r)"
using pre by(clarsimp simp:pre_subdivFace'_def)
show ?thesis using Some True IH[OF mgp pre' fg mt] ‹r ≠ v›
by(auto simp: between_next_empty[OF distf]
unroll_between_next2[OF distf ‹r ∈ 𝒱 f› ‹u ∈ 𝒱 f›])
next
case False
let ?vs = "[countVertices g..<countVertices g + n]"
let ?fdg = "splitFace g u v f ?vs"
let ?g' = "snd(snd ?fdg)" and ?f⇩2 = "fst(snd ?fdg)"
let ?fvu = "between (vertices f) v u"
have False': "f ∙ u = v ⟶ n ≠ 0" using False by auto
have VfVg: "𝒱 f ⊆ 𝒱 g" using mgp fg
by (simp add: minGraphProps_def faces_subset_def)
note pre_fdg = pre_subdivFace'_preFaceDiv[OF pre fg False' VfVg]
hence "u ≠ v" and "v ∈ 𝒱 f" and disj: "𝒱 f ∩ set ?vs = {}"
by(unfold pre_splitFace_def)simp+
hence vvs: "v ∉ set ?vs" by auto
have vf⇩2: "vertices ?f⇩2 = [v] @ ?fvu @ u # ?vs"
by(simp add:split_face_def splitFace_def split_def)
hence betuvf⇩2: "between (vertices ?f⇩2) u v = ?vs"
using splitFace_distinct1[OF pre_fdg]
by(simp add: between_back)
have betrvf⇩2: "r ≠ u ⟹ between (vertices ?f⇩2) r v =
between (vertices f) r u @ [u] @ ?vs"
proof -
assume "r≠u"
have r: "r ∈ set (between (vertices f) v u)"
using ‹r≠u› ‹r≠v› ‹u≠v› ‹v ∈ 𝒱 f› ‹r ∈ 𝒱 f› distf ruv
by(blast intro:rotate_before_vFrom before_between)
have "between (vertices f) v u =
between (vertices f) v r @ [r] @ between (vertices f) r u"
using split_between[OF distf ‹v ∈ 𝒱 f› ‹u ∈ 𝒱 f› r] ‹r≠v›
by simp
moreover hence "v ∉ set (between (vertices f) r u)"
using between_not_r1[OF distf, of v u] by simp
ultimately show ?thesis using vf⇩2 ‹r≠v› ‹u≠v› vvs
by (simp add: between_back between_not_r2[OF distf])
qed
note mgp' = splitFace_holds_minGraphProps[OF pre_fdg mgp]
note f2g = splitFace_add_f21'[OF fg]
note pre' = pre_subdivFace'_Some1[OF pre fg False' VfVg HOL.refl HOL.refl]
from pre_fdg have "v ∈ 𝒱 f" and disj: "𝒱 f ∩ set ?vs = {}"
by(unfold pre_splitFace_def, simp)+
have fr: "?f⇩2⇗-1⇖ ∙ r = f⇗-1⇖ ∙ r"
proof -
note pre_split = pre_splitFace_pre_split_face[OF pre_fdg]
have rinf⇩2: "r ∈ 𝒱 ?f⇩2"
proof cases
assume "r = u" thus ?thesis by(simp add:vf⇩2)
next
assume "r ≠ u"
hence "r ∈ set ?fvu" using distf ‹v : 𝒱 f› ‹r≠v› ‹r : 𝒱 f› ruv
by(blast intro: before_between rotate_before_vFrom)
thus ?thesis by(simp add:vf⇩2)
qed
have E⇩2: "ℰ ?f⇩2 = Edges (u # ?vs @ [v]) ∪
Edges (v # ?fvu @ [u])"
by(simp add:splitFace_def split_def
edges_split_face2[OF pre_split])
moreover have "(?f⇩2⇗-1⇖ ∙ r, r) ∈ ℰ ?f⇩2"
by(blast intro: prevVertex_in_edges rinf⇩2
splitFace_distinct1[OF pre_fdg])
moreover have "(?f⇩2⇗-1⇖ ∙ r, r) ∉ Edges (u # ?vs @ [v])"
proof -
have "r ∉ set ?vs" using ‹r : 𝒱 f› disj by blast
thus ?thesis using ‹r ≠ v›
by(simp add:Edges_Cons Edges_append notinset_notinEdge2) arith
qed
ultimately have "(?f⇩2⇗-1⇖ ∙ r, r) ∈ Edges (v # ?fvu @ [u])" by blast
hence "(?f⇩2⇗-1⇖ ∙ r, r) ∈ ℰ f" using pre_split_face_symI[OF pre_split]
by(blast intro: Edges_between_edges)
hence eq: "f ∙ (?f⇩2⇗-1⇖ ∙ r) = r" and inf: "?f⇩2⇗-1⇖ ∙ r ∈ 𝒱 f"
by(simp add:edges_face_eq)+
have "?f⇩2⇗-1⇖ ∙ r = f⇗-1⇖ ∙ (f ∙ (?f⇩2⇗-1⇖ ∙ r))"
using prevVertex_nextVertex[OF distf inf] by simp
also have "… = f⇗-1⇖ ∙ r" using eq by simp
finally show ?thesis .
qed
hence mt: "ovs = [] ⟶ 0 = 0 ∧ v = last (verticesFrom ?f⇩2 r)"
using pre' pre by(auto simp:pre_subdivFace'_def splitFace_def
split_def last_vFrom)
from IH[OF mgp' pre' f2g mt] ‹r ≠ v› obtain f' :: face where
f: "f' ∈ set(finals(subdivFace' ?g' ?f⇩2 v 0 ovs)) - set(finals ?g')"
and ff: "(?f⇩2⇗-1⇖ ∙ r, r) ∈ ℰ f'"
"|vertices f'| = |ovs| + |between (vertices ?f⇩2) r v| + 2"
by simp blast
show ?thesis (is "∃f' ∈ ?F. ?P f'")
proof
show "f' ∈ ?F" using f pre Some fg
by(simp add:False split_def pre_subdivFace'_def)
show "?P f'" using ff fr by(clarsimp simp:betuvf⇩2 betrvf⇩2)
qed
qed
qed
qed
lemma Seed_max_final_ex:
"∃f∈set (finals (Seed p)). |vertices f| = maxGon p"
by (simp add: Seed_def graph_max_final_ex)
lemma max_face_ex: assumes a: "Seed⇘p⇙ [next_plane0⇘p⇙]→* g"
shows "∃f ∈ set (finals g). |vertices f| = maxGon p"
using a
proof (induct rule: RTranCl_induct)
case refl then show ?case using Seed_max_final_ex by simp
next
case (succs g g')
then obtain f where f: "f∈set (finals g)" and "|vertices f| = maxGon p"
by auto
moreover from succs(1) f have "f∈set (finals g')" by (rule next_plane0_finals_incr)
ultimately show ?case by auto
qed
end
Theory ListSum
section "Summation Over Lists"
theory ListSum
imports ListAux
begin
primrec ListSum :: "'b list ⇒ ('b ⇒ 'a::comm_monoid_add) ⇒ 'a::comm_monoid_add" where
"ListSum [] f = 0"
| "ListSum (l#ls) f = f l + ListSum ls f"
syntax "_ListSum" :: "idt ⇒ 'b list ⇒ ('a::comm_monoid_add) ⇒
('a::comm_monoid_add)" ("∑⇘_∈_⇙ _" [0, 0, 10] 10)
translations "∑⇘x∈xs⇙ f" == "CONST ListSum xs (λx. f)"
lemma [simp]: "(∑⇘v ∈ V⇙ 0) = (0::nat)" by (induct V) simp_all
lemma ListSum_compl1:
"(∑⇘x ∈ [x←xs. ¬ P x]⇙ f x) + (∑⇘x ∈ [x←xs. P x]⇙ f x) = (∑⇘x ∈ xs⇙ (f x::nat))"
by (induct xs) simp_all
lemma ListSum_compl2:
"(∑⇘x ∈ [x←xs. P x]⇙ f x) + (∑⇘x ∈ [x←xs. ¬ P x]⇙ f x) = (∑⇘x ∈ xs⇙ (f x::nat))"
by (induct xs) simp_all
lemmas ListSum_compl = ListSum_compl1 ListSum_compl2
lemma ListSum_conv_sum:
"distinct xs ⟹ ListSum xs f = sum f (set xs)"
by(induct xs) simp_all
lemma listsum_cong:
"⟦ xs = ys; ⋀y. y ∈ set ys ⟹ f y = g y ⟧
⟹ ListSum xs f = ListSum ys g"
apply simp
apply(erule thin_rl)
by (induct ys) simp_all
lemma strong_listsum_cong[cong]:
"⟦ xs = ys; ⋀y. y ∈ set ys =simp=> f y = g y ⟧
⟹ ListSum xs f = ListSum ys g"
by(auto simp:simp_implies_def intro!:listsum_cong)
lemma ListSum_eq [trans]:
"(⋀v. v ∈ set V ⟹ f v = g v) ⟹ (∑⇘v ∈ V⇙ f v) = (∑⇘v ∈ V⇙ g v)"
by(auto intro!:listsum_cong)
lemma ListSum_disj_union:
"distinct A ⟹ distinct B ⟹ distinct C ⟹
set C = set A ∪ set B ⟹
set A ∩ set B = {} ⟹
(∑⇘a ∈ C⇙ (f a)) = (∑⇘a ∈ A⇙ f a) + (∑⇘a ∈ B⇙ (f a::nat))"
by (simp add: ListSum_conv_sum sum.union_disjoint)
lemma listsum_const[simp]:
"(∑⇘x ∈ xs⇙ k) = length xs * k"
by (induct xs) (simp_all add: ring_distribs)
lemma ListSum_add:
"(∑⇘x ∈ V⇙ f x) + (∑⇘x ∈ V⇙ g x) = (∑⇘x ∈ V⇙ (f x + (g x::nat)))"
by (induct V) auto
lemma ListSum_le:
"(⋀v. v ∈ set V ⟹ f v ≤ g v) ⟹ (∑⇘v ∈ V⇙ f v) ≤ (∑⇘v ∈ V⇙ (g v::nat))"
proof (induct V)
case Nil then show ?case by simp
next
case (Cons v V) then have "(∑⇘v ∈ V⇙ f v) ≤ (∑⇘v ∈ V⇙ g v)" by simp
moreover from Cons have "f v ≤ g v" by simp
ultimately show ?case by simp
qed
lemma ListSum1_bound:
"a ∈ set F ⟹ (d a::nat)≤ (∑⇘f ∈ F⇙ d f)"
by (induct F) auto
end
Theory Tame
section‹Tameness›
theory Tame
imports Graph ListSum
begin
subsection ‹Constants \label{sec:TameConstants}›
definition squanderTarget :: "nat" where
"squanderTarget ≡ 15410"
definition excessTCount :: "nat" ("𝖺")where
"𝖺 ≡ 6295"
definition squanderVertex :: "nat ⇒ nat ⇒ nat" ("𝖻")where
"𝖻 p q ≡ if p = 0 ∧ q = 3 then 6177
else if p = 0 ∧ q = 4 then 9696
else if p = 1 ∧ q = 2 then 6557
else if p = 1 ∧ q = 3 then 6176
else if p = 2 ∧ q = 1 then 7967
else if p = 2 ∧ q = 2 then 4116
else if p = 2 ∧ q = 3 then 12846
else if p = 3 ∧ q = 1 then 3106
else if p = 3 ∧ q = 2 then 8165
else if p = 4 ∧ q = 0 then 3466
else if p = 4 ∧ q = 1 then 3655
else if p = 5 ∧ q = 0 then 395
else if p = 5 ∧ q = 1 then 11354
else if p = 6 ∧ q = 0 then 6854
else if p = 7 ∧ q = 0 then 14493
else squanderTarget"
definition squanderFace :: "nat ⇒ nat" ("𝖽")where
"𝖽 n ≡ if n = 3 then 0
else if n = 4 then 2058
else if n = 5 then 4819
else if n = 6 then 7120
else squanderTarget"
text_raw‹
\index{‹𝖺›}
\index{‹𝖻›}
\index{‹𝖽›}
›
subsection‹Separated sets of vertices \label{sec:TameSeparated}›
text ‹A set of vertices $V$ is {\em separated},
\index{separated}
\index{‹separated›}
iff the following conditions hold:
›
text ‹2. No two vertices in V are adjacent:›
definition separated⇩2 :: "graph ⇒ vertex set ⇒ bool" where
"separated⇩2 g V ≡ ∀v ∈ V. ∀f ∈ set (facesAt g v). f∙v ∉ V"
text ‹3. No two vertices lie on a common quadrilateral:›
definition separated⇩3 :: "graph ⇒ vertex set ⇒ bool" where
"separated⇩3 g V ≡
∀v ∈ V. ∀f ∈ set (facesAt g v). |vertices f|≤4 ⟶ 𝒱 f ∩ V = {v}"
text ‹A set of vertices is called {\em separated},
\index{separated} \index{‹separated›}
iff no two vertices are adjacent or lie on a common quadrilateral:›
definition separated :: "graph ⇒ vertex set ⇒ bool" where
"separated g V ≡ separated⇩2 g V ∧ separated⇩3 g V"
subsection‹Admissible weight assignments\label{sec:TameAdmissible}›
text ‹
A weight assignment ‹w :: face ⇒ nat›
assigns a natural number to every face.
\index{‹admissible›}
\index{admissible weight assignment}
We formalize the admissibility requirements as follows:
›
definition admissible⇩1 :: "(face ⇒ nat) ⇒ graph ⇒ bool" where
"admissible⇩1 w g ≡ ∀f ∈ ℱ g. 𝖽 |vertices f| ≤ w f"
definition admissible⇩2 :: "(face ⇒ nat) ⇒ graph ⇒ bool" where
"admissible⇩2 w g ≡
∀v ∈ 𝒱 g. except g v = 0 ⟶ 𝖻 (tri g v) (quad g v) ≤ (∑⇘f∈facesAt g v⇙ w f)"
definition admissible⇩3 :: "(face ⇒ nat) ⇒ graph ⇒ bool" where
"admissible⇩3 w g ≡
∀v ∈ 𝒱 g. vertextype g v = (5,0,1) ⟶ (∑⇘f∈filter triangle (facesAt g v)⇙ w(f)) ≥ 𝖺"
text ‹Finally we define admissibility of weights functions.›
definition admissible :: "(face ⇒ nat) ⇒ graph ⇒ bool" where
"admissible w g ≡ admissible⇩1 w g ∧ admissible⇩2 w g ∧ admissible⇩3 w g"
subsection‹Tameness \label{sec:TameDef}›
definition tame9a :: "graph ⇒ bool" where
"tame9a g ≡ ∀f ∈ ℱ g. 3 ≤ |vertices f| ∧ |vertices f| ≤ 6"
definition tame10 :: "graph ⇒ bool" where
"tame10 g = (let n = countVertices g in 13 ≤ n ∧ n ≤ 15)"
definition tame10ub :: "graph ⇒ bool" where
"tame10ub g = (countVertices g ≤ 15)"
definition tame11a :: "graph ⇒ bool" where
"tame11a g = (∀v ∈ 𝒱 g. 3 ≤ degree g v)"
definition tame11b :: "graph ⇒ bool" where
"tame11b g = (∀v ∈ 𝒱 g. degree g v ≤ (if except g v = 0 then 7 else 6))"
definition tame12o :: "graph ⇒ bool" where
"tame12o g =
(∀v ∈ 𝒱 g. except g v ≠ 0 ∧ degree g v = 6 ⟶ vertextype g v = (5,0,1))"
text ‹7. There exists an admissible weight assignment of total
weight less than the target:›
definition tame13a :: "graph ⇒ bool" where
"tame13a g = (∃w. admissible w g ∧ (∑⇘f ∈ faces g⇙ w f) < squanderTarget)"
text ‹Finally we define the notion of tameness.›
definition tame :: "graph ⇒ bool" where
"tame g ≡ tame9a g ∧ tame10 g ∧ tame11a g ∧ tame11b g ∧ tame12o g ∧ tame13a g"
end
Theory Plane1Props
theory Plane1Props
imports Plane1 PlaneProps Tame
begin
lemma next_plane_subset:
"∀f ∈ ℱ g. vertices f ≠ [] ⟹
set (next_plane⇘p⇙ g) ⊆ set (next_plane0⇘p⇙ g)"
apply(clarsimp simp:next_plane0_def next_plane_def minimalFace_def finalGraph_def)
apply(rule_tac x = "minimal (size ∘ vertices) (nonFinals g)" in bexI)
apply(rule_tac x = "minimalVertex g (minimal (size ∘ vertices) (nonFinals g))" in bexI)
apply blast
apply(subgoal_tac "∀f∈set (nonFinals g). vertices f ≠ []")
apply(simp add:minimalVertex_def)
apply(simp add:nonFinals_def)
apply simp
done
lemma mgp_next_plane0_if_next_plane:
"minGraphProps g ⟹ g [next_plane⇘p⇙]→ g' ⟹ g [next_plane0⇘p⇙]→ g'"
using next_plane_subset by(blast dest: mgp_vertices_nonempty)
lemma inv_inv_next_plane: "invariant inv next_plane⇘p⇙"
apply(rule inv_subset[OF inv_inv_next_plane0])
apply(blast dest: mgp_next_plane0_if_next_plane[OF inv_mgp])
done
end
Theory Generator
section ‹Enumeration of Tame Plane Graphs›
theory Generator
imports Plane1 Tame
begin
text‹\paragraph{Lower bounds for total weight}›
definition faceSquanderLowerBound :: "graph ⇒ nat" where
"faceSquanderLowerBound g ≡ ∑⇘f ∈ finals g⇙ 𝖽 |vertices f|"
definition d3_const :: nat where
"d3_const == 𝖽 3"
definition d4_const :: nat where
"d4_const == 𝖽 4"
definition excessAtType :: "nat ⇒ nat ⇒ nat ⇒ nat" where
"excessAtType t q e ≡
if e = 0 then if 7 < t + q then squanderTarget
else 𝖻 t q - t * d3_const - q * d4_const
else if t + q + e ≠ 6 then 0
else if t=5 then 𝖺 else squanderTarget"
declare d3_const_def[simp] d4_const_def[simp]
definition ExcessAt :: "graph ⇒ vertex ⇒ nat" where
"ExcessAt g v ≡ if ¬ finalVertex g v then 0
else excessAtType (tri g v) (quad g v) (except g v)"
definition ExcessTable :: "graph ⇒ vertex list ⇒ (vertex × nat) list" where
"ExcessTable g vs ≡
[(v, ExcessAt g v). v ← [v ← vs. 0 < ExcessAt g v ]]"
text‹Implementation:›
lemma [code]:
"ExcessTable g =
List.map_filter (λv. let e = ExcessAt g v in if 0 < e then Some (v, e) else None)"
by (rule ext) (simp add: ExcessTable_def map_filter_def)
definition deleteAround :: "graph ⇒ vertex ⇒ (vertex × nat) list ⇒ (vertex × nat) list" where
"deleteAround g v ps ≡
let fs = facesAt g v;
ws = ⨆⇘f∈fs⇙ if |vertices f| = 4 then [f∙v, f⇗2⇖∙v] else [f∙v] in
removeKeyList ws ps"
text‹Implementation:›
lemma [code]: "deleteAround g v ps =
(let vs = (λf. let n = f∙v
in if |vertices f| = 4 then [n, f∙n] else [n])
in removeKeyList (concat(map vs (facesAt g v))) ps)"
by (simp only: concat_map_singleton Let_def deleteAround_def nextV2)
lemma length_deleteAround: "length (deleteAround g v ps) ≤ length ps"
by (auto simp only: deleteAround_def length_removeKeyList Let_def)
function ExcessNotAtRec :: "(nat, nat) table ⇒ graph ⇒ nat" where
"ExcessNotAtRec [] = (λg. 0)"
| "ExcessNotAtRec ((x, y)#ps) = (λg. max (ExcessNotAtRec ps g)
(y + ExcessNotAtRec (deleteAround g x ps) g))"
by pat_completeness auto
termination by (relation "measure size")
(auto simp add: length_deleteAround less_Suc_eq_le)
definition ExcessNotAt :: "graph ⇒ vertex option ⇒ nat" where
"ExcessNotAt g v_opt ≡
let ps = ExcessTable g (vertices g) in
case v_opt of None ⇒ ExcessNotAtRec ps g
| Some v ⇒ ExcessNotAtRec (deleteAround g v ps) g"
definition squanderLowerBound :: "graph ⇒ nat" where
"squanderLowerBound g ≡ faceSquanderLowerBound g + ExcessNotAt g None"
text‹\paragraph{Tame graph enumeration}›
definition is_tame13a :: "graph ⇒ bool" where
"is_tame13a g ≡ squanderLowerBound g < squanderTarget"
definition notame :: "graph ⇒ bool" where
"notame g ≡ ¬ (tame10ub g ∧ tame11b g)"
definition notame7 :: "graph ⇒ bool" where
"notame7 g ≡ ¬ (tame10ub g ∧ tame11b g ∧ is_tame13a g)"
definition generatePolygonTame :: "nat ⇒ vertex ⇒ face ⇒ graph ⇒ graph list" where
"generatePolygonTame n v f g ≡
let
enumeration = enum n |vertices f|;
enumeration = [is ← enumeration. ¬ containsDuplicateEdge g f v is];
vertexLists = [indexToVertexList f v is. is ← enumeration]
in
[g' ← [subdivFace g f vs. vs ← vertexLists] . ¬ notame g']"
definition polysizes :: "nat ⇒ graph ⇒ nat list" where
"polysizes p g ≡
let lb = squanderLowerBound g in
[n ← [3 ..< Suc(maxGon p)]. lb + 𝖽 n < squanderTarget]"
definition next_tame0 :: "nat ⇒ graph ⇒ graph list" ("next'_tame0⇘_⇙") where
"next_tame0⇘p⇙ g ≡
let fs = nonFinals g in
if fs = [] then []
else let f = minimalFace fs; v = minimalVertex g f
in ⨆⇘i ∈ polysizes p g⇙ generatePolygonTame i v f g"
text‹\noindent Extensionally, @{const next_tame0} is just
@{term"filter P ∘ next_plane p"} for some suitable ‹P›. But
efficiency suffers considerably if we first create many graphs and
then filter out the ones not in @{const polysizes}.›
end
Theory TameProps
section‹Tame Properties›
theory TameProps
imports Tame RTranCl
begin
lemma length_disj_filter_le: "∀x ∈ set xs. ¬(P x ∧ Q x) ⟹
length(filter P xs) + length(filter Q xs) ≤ length xs"
by(induct xs) auto
lemma tri_quad_le_degree: "tri g v + quad g v ≤ degree g v"
proof -
let ?fins = "[f ← facesAt g v . final f]"
have "tri g v + quad g v =
|[f ← ?fins . triangle f]| + |[f ← ?fins. |vertices f| = 4]|"
by(simp add:tri_def quad_def)
also have "… ≤ |[f ← facesAt g v. final f]|"
by(rule length_disj_filter_le) simp
also have "… ≤ |facesAt g v|" by(rule length_filter_le)
finally show ?thesis by(simp add:degree_def)
qed
lemma faceCountMax_bound:
"⟦ tame g; v ∈ 𝒱 g ⟧ ⟹ tri g v + quad g v ≤ 7"
using tri_quad_le_degree[of g v]
by(auto simp:tame_def tame11b_def split:if_split_asm)
lemma filter_tame_succs:
assumes invP: "invariant P succs" and fin: "⋀g. final g ⟹ succs g = []"
and ok_untame: "⋀g. P g ⟹ ¬ ok g ⟹ final g ∧ ¬ tame g"
and gg': "g [succs]→* g'"
shows "P g ⟹ final g' ⟹ tame g' ⟹ g [filter ok ∘ succs]→* g'"
using gg'
proof (induct rule:RTranCl.induct)
case refl show ?case by(rule RTranCl.refl)
next
case (succs h h' h'')
hence "P h'" using invP by(unfold invariant_def) blast
show ?case
proof cases
assume "ok h'"
thus ?thesis using succs ‹P h'› by(fastforce intro:RTranCl.succs)
next
assume "¬ ok h'" note fin_tame = ok_untame[OF ‹P h'› ‹¬ ok h'›]
have "h'' = h'" using fin_tame
by(rule_tac RTranCl.cases[OF succs(2)])(auto simp:fin)
hence False using fin_tame succs by fast
thus ?case ..
qed
qed
definition untame :: "(graph ⇒ bool) ⇒ bool" where
"untame P ≡ ∀g. final g ∧ P g ⟶ ¬ tame g"
lemma filterout_untame_succs:
assumes invP: "invariant P f" and invPU: "invariant (λg. P g ∧ U g) f"
and untame: "untame(λg. P g ∧ U g)"
and new_untame: "⋀g g'. ⟦ P g; g' ∈ set(f g); g' ∉ set(f' g) ⟧ ⟹ U g'"
and gg': "g [f]→* g'"
shows "P g ⟹ final g' ⟹ tame g' ⟹ g [f']→* g'"
using gg'
proof (induct rule:RTranCl.induct)
case refl show ?case by(rule RTranCl.refl)
next
case (succs h h' h'')
hence Ph': "P h'" using invP by(unfold invariant_def) blast
show ?case
proof cases
assume "h' ∈ set(f' h)"
thus ?thesis using succs Ph' by(blast intro:RTranCl.succs)
next
assume "h' ∉ set(f' h)"
with succs(4) succs(1) have "U h'" by (rule new_untame)
hence False using Ph' RTranCl_inv[OF invPU] untame succs
by (unfold untame_def) fast
thus ?case ..
qed
qed
end
Theory TameEnum
section ‹Neglectable Final Graphs›
theory TameEnum
imports Generator
begin
definition is_tame :: "graph ⇒ bool" where
"is_tame g ≡ tame10 g ∧ tame11a g ∧ tame12o g ∧ is_tame13a g"
definition next_tame :: "nat ⇒ graph ⇒ graph list" ("next'_tame⇘_⇙") where
"next_tame⇘p⇙ ≡ filter (λg. ¬ final g ∨ is_tame g) ∘ next_tame0⇘p⇙"
definition TameEnumP :: "nat ⇒ graph set" ("TameEnum⇘_⇙") where
"TameEnum⇘p⇙ ≡ {g. Seed⇘p⇙ [next_tame⇘p⇙]→* g ∧ final g}"
definition TameEnum :: "graph set" where
"TameEnum ≡ ⋃p≤3. TameEnum⇘p⇙"
end
Theory ScoreProps
section ‹Properties of Lower Bound Machinery›
theory ScoreProps
imports ListSum TameEnum PlaneProps TameProps
begin
lemma deleteAround_empty[simp]: "deleteAround g a [] = []"
by (simp add: deleteAround_def)
lemma deleteAroundCons:
"deleteAround g a (p#ps) =
(if fst p ∈ {v. ∃f ∈ set (facesAt g a).
(length (vertices f) = 4) ∧ v ∈ {f ∙ a, f ∙ (f ∙ a)}
∨ (length (vertices f) ≠ 4) ∧ (v = f ∙ a)}
then deleteAround g a ps
else p#deleteAround g a ps)"
by (fastforce simp: nextV2 deleteAround_def)
lemma deleteAround_subset: "set (deleteAround g a ps) ⊆ set ps"
by (simp add: deleteAround_def)
lemma distinct_deleteAround: "distinct (map fst ps) ⟹
distinct (map fst (deleteAround g (fst (a, b)) ps))"
proof (induct ps)
case Nil then show ?case by simp
next
case (Cons p ps)
then have "fst p ∉ fst ` set ps" by simp
moreover have "set (deleteAround g a ps) ⊆ set ps"
by (rule deleteAround_subset)
ultimately have "fst p ∉ fst ` set (deleteAround g a ps)" by auto
moreover from Cons have "distinct (map fst ps)" by simp
then have "distinct (map fst (deleteAround g (fst (a, b)) ps))"
by (rule Cons)
ultimately show ?case by (simp add: deleteAroundCons)
qed
definition deleteAround' :: "graph ⇒ vertex ⇒ (vertex × nat) list ⇒
(vertex × nat) list" where
"deleteAround' g v ps ≡
let fs = facesAt g v;
vs = (λf. let n1 = f ∙ v;
n2 = f ∙ n1 in
if length (vertices f) = 4 then [n1, n2] else [n1]);
ws = concat (map vs fs) in
removeKeyList ws ps"
lemma deleteAround_eq: "deleteAround g v ps = deleteAround' g v ps"
apply (auto simp add: deleteAround_def deleteAround'_def split: if_split_asm)
apply (unfold nextV2[THEN eq_reflection], simp)
done
lemma deleteAround_nextVertex:
"f ∈ set (facesAt g a) ⟹
(f ∙ a, b) ∉ set (deleteAround g a ps)"
by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)
lemma deleteAround_nextVertex_nextVertex:
"f ∈ set (facesAt g a) ⟹ |vertices f| = 4 ⟹
(f ∙ (f ∙ a), b) ∉ set (deleteAround g a ps)"
by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)
lemma deleteAround_prevVertex:
"minGraphProps g ⟹ a : 𝒱 g ⟹ f ∈ set (facesAt g a) ⟹
(f⇗-1⇖ ∙ a, b) ∉ set (deleteAround g a ps)"
proof -
assume a: "minGraphProps g" "a : 𝒱 g" "f ∈ set (facesAt g a)"
have "(f⇗-1⇖ ∙ a, a) ∈ ℰ f" using a
by(blast intro:prevVertex_in_edges minGraphProps)
then obtain f' :: face where f': "f' ∈ set(facesAt g a)"
and e: "(a, f⇗-1⇖ ∙ a) ∈ ℰ f'"
using a by(blast dest:mgp_edge_face_ex)
have "(f' ∙ a, b) ∉ set (deleteAround g a ps)" using f'
by (auto simp add: deleteAround_eq deleteAround'_def removeKeyList_eq)
moreover have "f' ∙ a = f⇗-1⇖ ∙ a"
using e by (simp add:edges_face_eq)
ultimately show ?thesis by simp
qed
lemma deleteAround_separated:
assumes mgp: "minGraphProps g" and fin: "final g" and ag: "a : 𝒱 g" and 4: "|vertices f| ≤ 4"
and f: "f ∈ set(facesAt g a)"
shows "𝒱 f ∩ set [fst p. p ← deleteAround g a ps] ⊆ {a}" (is "?A")
proof -
note MGP = mgp ag f
have af: "a ∈ 𝒱 f" using MGP by(blast intro:minGraphProps)
have "2 < |vertices f|" using MGP by(blast intro:minGraphProps)
with 4 have "|vertices f| = 3 ∨ |vertices f| = 4" by arith
then show "?A"
proof
assume 3: "|vertices f| = 3"
show "?A"
proof (rule ccontr)
assume "¬ ?A"
then obtain b where b1: "b ≠ a" "b ∈ 𝒱 f"
"b ∈ set (map fst (deleteAround g a ps))" by auto
from MGP have d: "distinct (vertices f)"
by(blast intro:minGraphProps)
with af 3 have "𝒱 f = {a, f ∙ a, f ∙ (f ∙ a)}"
by (rule_tac vertices_triangle)
also from d af 3 have
"f ∙ (f ∙ a) = f⇗-1⇖ ∙ a"
by (simp add: triangle_nextVertex_prevVertex)
finally have
"b ∈ {f ∙ a, f⇗-1⇖ ∙ a}"
using b1 by simp
with MGP have "b ∉ set (map fst (deleteAround g a ps))"
using deleteAround_nextVertex deleteAround_prevVertex by auto
then show False by contradiction (rule b1)
qed
next
assume 4: "|vertices f| = 4"
show "?A"
proof (rule ccontr)
assume "¬ ?A"
then obtain b where b1: "b ≠ a" "b ∈ 𝒱 f"
"b ∈ set (map fst (deleteAround g a ps))" by auto
from MGP have d: "distinct (vertices f)" by(blast intro:minGraphProps)
with af 4 have "𝒱 f = {a, f ∙ a, f ∙ (f ∙ a), f ∙ (f ∙ (f ∙ a))}"
by (rule_tac vertices_quad)
also from d af 4 have "f ∙ (f ∙ (f ∙ a)) = f⇗-1⇖ ∙ a"
by (simp add: quad_nextVertex_prevVertex)
finally have "b ∈ {f ∙ a, f ∙ (f ∙ a), f⇗-1⇖ ∙ a}"
using b1 by simp
with MGP 4 have "b ∉ set (map fst (deleteAround g a ps))"
using deleteAround_nextVertex deleteAround_prevVertex
deleteAround_nextVertex_nextVertex by auto
then show False by contradiction (rule b1)
qed
qed
qed
lemma [iff]: "separated g {}"
by (simp add: separated_def separated⇩2_def separated⇩3_def)
lemma separated_insert:
assumes mgp: "minGraphProps g" and a: "a ∈ 𝒱 g"
and Vg: "V ⊆ 𝒱 g"
and ps: "separated g V"
and s2: "(⋀f. f ∈ set (facesAt g a) ⟹ f ∙ a ∉ V)"
and s3: "(⋀f. f ∈ set (facesAt g a) ⟹
|vertices f| ≤ 4 ⟹ 𝒱 f ∩ V ⊆ {a})"
shows "separated g (insert a V)"
proof (simp add: separated_def separated⇩2_def separated⇩3_def,
intro conjI ballI impI)
fix f assume f: "f ∈ set (facesAt g a)"
then show "f ∙ a ≠ a" by (rule mgp_facesAt_no_loop[OF mgp a])
from f show "f ∙ a ∉ V" by (rule s2)
next
fix f v assume v: "f ∈ set (facesAt g v)" and vV: "v ∈ V"
have "v : 𝒱 g" using vV Vg by blast
show "f ∙ v ≠ a"
proof
assume f: "f ∙ v = a"
then obtain f' where f': "f' ∈ set(facesAt g a)" and v: "f' ∙ a = v"
using mgp_nextVertex_face_ex2[OF mgp ‹v : 𝒱 g› v] by blast
have "f' ∙ a ∈ V" using v vV by simp
with f' s2 show False by blast
qed
from ps v vV show "f ∙ v ∉ V"
by (simp add: separated_def separated⇩2_def)
next
fix f assume f: "f ∈ set (facesAt g a)" "|vertices f| ≤ 4"
then have "𝒱 f ∩ V ⊆ {a}" by (rule s3)
moreover from mgp a f have "a ∈ 𝒱 f" by(blast intro:minGraphProps)
ultimately show "𝒱 f ∩ insert a V = {a}" by auto
next
fix v f
assume a: "v ∈ V" "f ∈ set (facesAt g v)"
"|vertices f| ≤ 4"
with ps have v: "𝒱 f ∩ V = {v}"
by (simp add: separated_def separated⇩3_def)
have "v : 𝒱 g" using a Vg by blast
show "𝒱 f ∩ insert a V = {v}"
proof cases
assume "a = v"
with v mgp a show ?thesis by(blast intro:minGraphProps)
next
assume n: "a ≠ v"
have "a ∉ 𝒱 f"
proof
assume a2: "a ∈ 𝒱 f"
with mgp a ‹v : 𝒱 g› have "f ∈ ℱ g" by(blast intro:minGraphProps)
with mgp a2 have "f ∈ set (facesAt g a)" by(blast intro:minGraphProps)
with a have "𝒱 f ∩ V ⊆ {a}" by (simp add: s3)
with v have "a = v" by auto
with n show False by auto
qed
with a v show "𝒱 f ∩ insert a V = {v}" by blast
qed
qed
function ExcessNotAtRecList :: "(vertex, nat) table ⇒ graph ⇒ vertex list" where
"ExcessNotAtRecList [] = (λg. [])"
| "ExcessNotAtRecList ((x, y) # ps) = (λg.
let l1 = ExcessNotAtRecList ps g;
l2 = ExcessNotAtRecList (deleteAround g x ps) g in
if ExcessNotAtRec ps g
≤ y + ExcessNotAtRec (deleteAround g x ps) g
then x # l2 else l1)"
by pat_completeness auto
termination by (relation "measure size")
(auto simp add: less_Suc_eq_le length_deleteAround)
lemma isTable_deleteAround:
"isTable E vs ((a,b)#ps) ⟹ isTable E vs (deleteAround g a ps)"
by (rule isTable_subset, rule deleteAround_subset,
rule isTable_Cons)
lemma ListSum_ExcessNotAtRecList:
"isTable E vs ps ⟹ ExcessNotAtRec ps g
= (∑⇘p ∈ ExcessNotAtRecList ps g⇙ E p)" (is "?T ps ⟹ ?P ps")
proof (induct ps rule: ExcessNotAtRecList.induct)
case 1 show ?case by simp
next
case (2 a b ps)
from 2 have prem: "?T ((a,b)#ps)" by blast
then have E: "b = E a" by (simp add: isTable_eq)
from 2 have hyp1: "?T (deleteAround g a ps) ⟹
?P (deleteAround g a ps)" by blast
from 2 have hyp2: "?T ps ⟹ ?P ps" by blast
have H1: "?P (deleteAround g a ps)"
by (rule hyp1, rule isTable_deleteAround) (rule prem)
have H2: "?P ps" by (rule hyp2, rule isTable_Cons, rule prem)
show "?P ((a,b)#ps)"
proof cases
assume
"ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
with H1 E show ?thesis
by (simp add: max_def split: if_split_asm)
next
assume "¬ ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
with H2 E show ?thesis
by (simp add: max_def split: if_split_asm)
qed
qed
lemma ExcessNotAtRecList_subset:
"set (ExcessNotAtRecList ps g) ⊆ set [fst p. p ← ps]" (is "?P ps")
proof (induct ps rule: ExcessNotAtRecList.induct)
case 1 show ?case by simp
next
case (2 a b ps)
presume H1: "?P (deleteAround g a ps)"
presume H2: "?P ps"
show "?P ((a, b) # ps)"
proof cases
assume a: "ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
have "set (deleteAround g a ps) ⊆ set ps"
by (simp add: deleteAround_subset)
then have
"fst ` set (deleteAround g a ps) ⊆ insert a (fst ` set ps)"
by blast
with a H1 show ?thesis by (simp)
next
assume "¬ ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
with H2 show ?thesis by (auto)
qed
qed simp
lemma separated_ExcessNotAtRecList:
"minGraphProps g ⟹ final g ⟹ isTable E (vertices g) ps ⟹
separated g (set (ExcessNotAtRecList ps g))"
proof -
assume fin: "final g" and mgp: "minGraphProps g"
show
"isTable E (vertices g) ps ⟹ separated g (set (ExcessNotAtRecList ps g))"
(is "?T ps ⟹ ?P ps")
proof (induct rule: ExcessNotAtRec.induct)
case 1 show ?case by simp
next
case (2 a b ps)
from 2 have prem: "?T ((a,b)#ps)" by blast
then have E: "b = E a" by (simp add: isTable_eq)
have "a :𝒱 g" using prem by(auto simp: isTable_def)
from 2 have hyp1: "?T (deleteAround g a ps) ⟹
?P (deleteAround g a ps)" by blast
from 2 have hyp2: "?T ps ⟹ ?P ps" by blast
have H1: "?P (deleteAround g a ps)"
by (rule hyp1, rule isTable_deleteAround) (rule prem)
have H2: "?P ps" by (rule hyp2, rule isTable_Cons) (rule prem)
show "?P ((a,b)#ps)"
proof cases
assume c: "ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
have "separated g
(insert a (set (ExcessNotAtRecList (deleteAround g a ps) g)))"
proof (rule separated_insert[OF mgp])
from prem show "a ∈ set (vertices g)" by (auto simp add: isTable_def)
show "set (ExcessNotAtRecList (deleteAround g a ps) g) ⊆ 𝒱 g"
proof-
have "set (ExcessNotAtRecList (deleteAround g a ps) g) ⊆
set (map fst (deleteAround g a ps))"
by(rule ExcessNotAtRecList_subset[simplified concat_map_singleton])
also have "… ⊆ set (map fst ps)"
using deleteAround_subset by fastforce
finally show ?thesis using prem by(auto simp: isTable_def)
qed
from H1
show pS: "separated g
(set (ExcessNotAtRecList (deleteAround g a ps) g))"
by simp
fix f assume f: "f ∈ set (facesAt g a)"
then have
"f ∙ a ∉ set [fst p. p ← deleteAround g a ps]"
by (auto simp add: facesAt_def deleteAround_eq deleteAround'_def
removeKeyList_eq split: if_split_asm)
moreover
have "set (ExcessNotAtRecList (deleteAround g a ps) g)
⊆ set [fst p. p ← deleteAround g a ps]"
by (rule ExcessNotAtRecList_subset)
ultimately
show "f ∙ a
∉ set (ExcessNotAtRecList (deleteAround g a ps) g)"
by auto
assume "|vertices f| ≤ 4"
from this f have "set (vertices f)
∩ set [fst p. p ← deleteAround g a ps] ⊆ {a}"
by (rule deleteAround_separated[OF mgp fin ‹a : 𝒱 g›])
moreover
have "set (ExcessNotAtRecList (deleteAround g a ps) g)
⊆ set [fst p. p ← deleteAround g a ps]"
by (rule ExcessNotAtRecList_subset)
ultimately
show "set (vertices f)
∩ set (ExcessNotAtRecList (deleteAround g a ps) g) ⊆ {a}"
by blast
qed
with H1 E c show ?thesis by (simp)
next
assume "¬ ExcessNotAtRec ps g
≤ b + ExcessNotAtRec (deleteAround g a ps) g"
with H2 E show ?thesis by simp
qed
qed
qed
lemma isTable_ExcessTable:
"isTable (λv. ExcessAt g v) vs (ExcessTable g vs)"
by (auto simp add: isTable_def ExcessTable_def ExcessAt_def)
lemma ExcessTable_subset:
"set (map fst (ExcessTable g vs)) ⊆ set vs"
by (induct vs) (auto simp add: ExcessTable_def)
lemma distinct_ExcessNotAtRecList:
"distinct (map fst ps) ⟹ distinct (ExcessNotAtRecList ps g)"
(is "?T ps ⟹ ?P ps")
proof (induct rule: ExcessNotAtRec.induct)
case 1 show ?case by simp
next
case (2 a b ps)
from 2 have prem: "?T ((a,b)#ps)" by blast
then have a: "a ∉ set (map fst ps)" by simp
from 2 have hyp1: "?T (deleteAround g a ps) ⟹
?P (deleteAround g a ps)" by blast
from 2 have hyp2: "?T ps ⟹ ?P ps" by blast
from 2 have "?T ps" by simp
then have H1: "?P (deleteAround g a ps)"
by (rule_tac hyp1) (rule distinct_deleteAround [simplified])
from prem have H2: "?P ps"
by (rule_tac hyp2) simp
have "a ∉ set (ExcessNotAtRecList (deleteAround g a ps) g)"
proof
assume "a ∈ set (ExcessNotAtRecList (deleteAround g a ps) g)"
also have "set (ExcessNotAtRecList (deleteAround g a ps) g)
⊆ set [fst p. p ← deleteAround g a ps]"
by (rule ExcessNotAtRecList_subset)
also have "set (deleteAround g a ps) ⊆ set ps"
by (rule deleteAround_subset)
then have "set [fst p. p ← deleteAround g a ps]
⊆ set [fst p. p ← ps]" by auto
finally have "a ∈ set (map fst ps)" by simp
with a show False by contradiction
qed
with H1 H2 show "?P ((a,b)#ps)"
by ( simp add: ExcessNotAtRecList_subset)
qed
primrec ExcessTable_cont ::
"(vertex ⇒ nat) ⇒ vertex list ⇒ (vertex × nat) list"
where
"ExcessTable_cont ExcessAtPG [] = []" |
"ExcessTable_cont ExcessAtPG (v#vs) =
(let vi = ExcessAtPG v in
if 0 < vi
then (v, vi)#ExcessTable_cont ExcessAtPG vs
else ExcessTable_cont ExcessAtPG vs)"
definition ExcessTable' :: "graph ⇒ vertex list ⇒ (vertex × nat) list" where
"ExcessTable' g ≡ ExcessTable_cont (ExcessAt g)"
lemma distinct_ExcessTable_cont:
"distinct vs ⟹
distinct (map fst (ExcessTable_cont (ExcessAt g) vs))"
proof (induct vs)
case Nil then show ?case by (simp add: ExcessTable_def)
next
case (Cons v vs)
from Cons have v: "v ∉ set vs" by simp
from Cons have "distinct vs" by simp
with Cons have IH:
"distinct (map fst (ExcessTable_cont (ExcessAt g) vs))"
by simp
moreover have
"v ∉ fst ` set (ExcessTable_cont (ExcessAt g) vs)"
proof
assume "v ∈ fst ` set (ExcessTable_cont (ExcessAt g) vs)"
also have "fst ` set (ExcessTable_cont (ExcessAt g) vs) ⊆ set vs"
by (induct vs) auto
finally have " v ∈ set vs" .
with v show False by contradiction
qed
ultimately show ?case by (simp add: ExcessTable_def)
qed
lemma ExcessTable_cont_eq:
"ExcessTable_cont E vs =
[(v, E v). v ← [v←vs . 0 < E v]]"
by (induct vs) (simp_all)
lemma ExcessTable_eq: "ExcessTable = ExcessTable'"
proof (rule ext, rule ext)
fix p g vs show "ExcessTable g vs = ExcessTable' g vs"
by (simp add: ExcessTable_def ExcessTable'_def ExcessTable_cont_eq)
qed
lemma distinct_ExcessTable:
"distinct vs ⟹ distinct [fst p. p ← ExcessTable g vs]"
by (simp_all add: ExcessTable_eq ExcessTable'_def distinct_ExcessTable_cont)
lemma ExcessNotAt_eq:
"minGraphProps g ⟹ final g ⟹
∃V. ExcessNotAt g None
= (∑⇘v ∈ V⇙ ExcessAt g v)
∧ separated g (set V) ∧ set V ⊆ set (vertices g)
∧ distinct V"
proof (intro exI conjI)
assume mgp: "minGraphProps g" and fin: "final g"
let ?ps = "ExcessTable g (vertices g)"
let ?V = "ExcessNotAtRecList ?ps g"
let ?vs = "vertices g"
let ?E = "λv. ExcessAt g v"
have t: "isTable ?E ?vs ?ps" by (rule isTable_ExcessTable)
with this show "ExcessNotAt g None = (∑⇘v ∈ ?V⇙ ?E v)"
by (simp add: ListSum_ExcessNotAtRecList ExcessNotAt_def)
show "separated g (set ?V)"
by(rule separated_ExcessNotAtRecList[OF mgp fin t])
have "set (ExcessNotAtRecList ?ps g) ⊆ set (map fst ?ps)"
by (rule ExcessNotAtRecList_subset[simplified concat_map_singleton])
also have "… ⊆ set (vertices g)" by (rule ExcessTable_subset)
finally show "set ?V ⊆ set (vertices g)" .
show "distinct ?V"
by (simp add: distinct_ExcessNotAtRecList distinct_ExcessTable[simplified concat_map_singleton])
qed
lemma excess_eq:
assumes 7: "t + q ≤ 7"
shows "excessAtType t q 0 + t * 𝖽 3 + q * 𝖽 4 = 𝖻 t q"
proof -
note simps = excessAtType_def squanderVertex_def squanderFace_def
nat_minus_add_max squanderTarget_def
from 7 have "q=0 ∨ q=1 ∨ q=2 ∨ q=3 ∨ q=4 ∨ q=5 ∨ q=6 ∨ q=7" by arith
then show ?thesis
proof (elim disjE)
assume q: "q = 0"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 1"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 2"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 3"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 4"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 5"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 6"
with 7 show ?thesis by (simp add: simps)
next
assume q: "q = 7"
with 7 show ?thesis by (simp add: simps)
qed
qed
lemma excess_eq1:
"⟦ inv g; final g; tame g; except g v = 0; v ∈ set(vertices g) ⟧ ⟹
ExcessAt g v + (tri g v) * 𝖽 3 + (quad g v) * 𝖽 4
= 𝖻 (tri g v) (quad g v)"
apply(subgoal_tac "finalVertex g v")
apply(simp add: ExcessAt_def excess_eq faceCountMax_bound)
apply(auto simp:finalVertex_def plane_final_facesAt)
done
text ‹separating›
definition separating :: "'a set ⇒ ('a ⇒ 'b set) ⇒ bool" where
"separating V F ≡
(∀v1 ∈ V. ∀v2 ∈ V. v1 ≠ v2 ⟶ F v1 ∩ F v2 = {})"
lemma separating_insert1:
"separating (insert a V) F ⟹ separating V F"
by (simp add: separating_def)
lemma separating_insert2:
"separating (insert a V) F ⟹ a ∉ V ⟹ v ∈ V ⟹
F a ∩ F v = {}"
by (auto simp add: separating_def)
lemma sum_disj_Union:
"finite V ⟹
(⋀f. finite (F f)) ⟹
separating V F ⟹
(∑v∈V. ∑f∈(F v). (w f::nat)) = (∑f∈(⋃v∈V. F v). w f)"
proof (induct rule: finite_induct)
case empty then show ?case by simp
next
case (insert a V)
then have s: "separating (insert a V) F" by simp
then have "separating V F" by (rule_tac separating_insert1)
with insert
have IH: "(∑v∈V. ∑f∈(F v). w f) = (∑f∈(⋃v∈V. F v). w f)"
by simp
moreover have fin: "finite V" "a ∉ V" "⋀f. finite (F f)" by fact+
moreover from s have "⋀v. a ∉ V ⟹ v ∈ V ⟹ F a ∩ F v = {}"
by (simp add: separating_insert2)
with fin have "(F a) ∩ (⋃v∈V. F v) = {}" by auto
ultimately show ?case by (simp add: sum.union_disjoint)
qed
lemma separated_separating:
assumes Vg: "set V ⊆ 𝒱 g"
and pS: "separated g (set V)"
and noex: "∀f∈P. |vertices f| ≤ 4"
shows "separating (set V) (λv. set (facesAt g v) ∩ P)"
proof -
from pS have i: "∀v∈set V. ∀f∈set (facesAt g v).
|vertices f| ≤ 4 ⟶ set (vertices f) ∩ set V = {v}"
by (simp add: separated_def separated⇩3_def)
show "separating (set V) (λv. set (facesAt g v) ∩ P)"
proof (simp add: separating_def, intro ballI impI)
fix v1 v2 assume v: "v1 ∈ set V" "v2 ∈ set V" "v1 ≠ v2"
hence "v1 : 𝒱 g" using Vg by blast
show "(set (facesAt g v1) ∩ P) ∩ (set (facesAt g v2) ∩ P) = {}" (is "?P")
proof (rule ccontr)
assume "¬ ?P"
then obtain f where f1: "f ∈ set (facesAt g v1)"
and f2: "f ∈ set (facesAt g v2)" and "f : P" by auto
with noex have l: "|vertices f| ≤ 4" by blast
from v f1 l i have "set (vertices f) ∩ set V = {v1}" by simp
also from v f2 l i
have "set (vertices f) ∩ set V = {v2}" by simp
finally have "v1 = v2" by auto
then show False by contradiction (rule v)
qed
qed
qed
lemma ListSum_V_F_eq_ListSum_F:
assumes pl: "inv g"
and pS: "separated g (set V)" and dist: "distinct V"
and V_subset: "set V ⊆ set (vertices g)"
and noex: "∀f ∈ Collect P. |vertices f| ≤ 4"
shows "(∑⇘v ∈ V⇙ ∑⇘f ∈ filter P (facesAt g v)⇙ (w::face ⇒ nat) f)
= (∑⇘f ∈ [f←faces g . ∃v ∈ set V. f ∈ set (facesAt g v) ∩ Collect P]⇙ w f)"
proof -
have s: "separating (set V) (λv. set (facesAt g v) ∩ Collect P)"
by (rule separated_separating[OF V_subset pS noex])
moreover note dist
moreover from pl V_subset
have "⋀v. v ∈ set V ⟹ distinct (facesAt g v)"
by(blast intro:mgp_dist_facesAt[OF inv_mgp])
hence v: "⋀v. v ∈ set V ⟹ distinct (filter P (facesAt g v))"
by simp
moreover
have "distinct [f←faces g . ∃v ∈ set V. f ∈ set (facesAt g v) ∩ Collect P]"
by (intro distinct_filter minGraphProps11'[OF inv_mgp[OF pl]])
moreover from pl have "{x. x ∈ ℱ g ∧ (∃v ∈ set V. x ∈ set (facesAt g v) ∧ P x)} =
(⋃v∈set V. set (facesAt g v) ∩ Collect P)" using V_subset
by (blast intro:minGraphProps inv_mgp)
moreover from v have "(∑v∈set V. ListSum (filter P (facesAt g v)) w) = (∑v∈set V. sum w (set(facesAt g v) ∩ Collect P))"
by (auto simp add: ListSum_conv_sum Int_def)
ultimately show ?thesis
by (simp add: ListSum_conv_sum sum_disj_Union)
qed
lemma separated_disj_Union2:
assumes pl: "inv g" and fin: "final g" and ne: "noExceptionals g (set V)"
and pS: "separated g (set V)" and dist: "distinct V"
and V_subset: "set V ⊆ set (vertices g)"
shows "(∑⇘v ∈ V⇙ ∑⇘f ∈ facesAt g v⇙ (w::face ⇒ nat) f)
= (∑⇘f ∈ [f←faces g . ∃v ∈ set V. f ∈ set (facesAt g v)]⇙ w f)"
proof -
let ?P = "λf. |vertices f| ≤ 4"
have "∀v ∈ set V. ∀f ∈ set (facesAt g v). |vertices f| ≤ 4"
using V_subset ne
by (auto simp: noExceptionals_def
intro: minGraphProps5[OF inv_mgp[OF pl]] not_exceptional[OF pl fin])
thus ?thesis
using ListSum_V_F_eq_ListSum_F[where P = ?P, OF pl pS dist V_subset]
by (simp add: Int_def cong: conj_cong)
qed
lemma squanderFace_distr2: "inv g ⟹ final g ⟹ noExceptionals g (set V) ⟹
separated g (set V) ⟹ distinct V ⟹ set V ⊆ set (vertices g) ⟹
(∑⇘f ∈ [f←faces g. ∃v ∈ set V. f ∈ set (facesAt g v)]⇙
𝖽 |vertices f| )
= (∑⇘v ∈ V⇙ ((tri g v) * 𝖽 3
+ (quad g v) * 𝖽 4))"
proof -
assume pl: "inv g"
assume fin: "final g"
assume ne: "noExceptionals g (set V)"
assume "separated g (set V)" "distinct V" and V_subset: "set V ⊆ set (vertices g)"
with pl ne fin have
"(∑⇘f ∈ [f←faces g. ∃v∈set V. f∈set (facesAt g v)]⇙ 𝖽 |vertices f| )
= (∑⇘v ∈ V⇙ ∑⇘f ∈ facesAt g v⇙ 𝖽 |vertices f| )"
by (simp add: separated_disj_Union2)
also have "⋀v. v ∈ set V ⟹
(∑⇘f ∈ facesAt g v⇙ 𝖽 |vertices f| )
= (tri g v) * 𝖽 3 + (quad g v) * 𝖽 4"
proof -
fix v assume v1: "v ∈ set V"
with V_subset have v: "v ∈ set (vertices g)" by auto
with ne have d:
"⋀f. f ∈ set (facesAt g v) ⟹
|vertices f| = 3 ∨ |vertices f| = 4"
proof -
fix f assume f: "f ∈ set (facesAt g v)"
then have ff: "f ∈ set (faces g)" by (rule minGraphProps5[OF inv_mgp[OF pl] v])
with ne f v1 pl fin v have "|vertices f| ≤ 4"
by (auto simp add: noExceptionals_def not_exceptional)
moreover from pl ff have "3 ≤ |vertices f|" by(rule planeN4)
ultimately show "?thesis f" by arith
qed
from d pl v have
"(∑⇘f ∈ facesAt g v⇙ 𝖽 |vertices f| )
= (∑⇘f∈[f ← facesAt g v. |vertices f| = 3]⇙ 𝖽 |vertices f| )
+ (∑⇘f∈[f ← facesAt g v. |vertices f| = 4]⇙ 𝖽 |vertices f| )"
apply (rule_tac ListSum_disj_union)
apply (rule distinct_filter) apply simp
apply (rule distinct_filter) apply simp
apply simp
apply force
apply force
done
also have "… = tri g v * 𝖽 3 + quad g v * 𝖽 4"
proof -
from pl fin v have "⋀A.[f ← facesAt g v. final f ∧ A f]
= [f ← facesAt g v. A f]"
by (rule_tac filter_eqI) (auto simp:plane_final_facesAt)
with fin show ?thesis by (auto simp add: tri_def quad_def)
qed
finally show "(∑⇘f ∈ facesAt g v⇙ 𝖽 |vertices f| ) = tri g v * 𝖽 3 + quad g v * 𝖽 4" .
qed
then have "(∑⇘v ∈ V⇙ ∑⇘f ∈ facesAt g v⇙ 𝖽 |vertices f| ) =
(∑⇘v ∈ V⇙ (tri g v * 𝖽 3 + quad g v * 𝖽 4))"
by (rule ListSum_eq)
finally show ?thesis .
qed
lemma separated_subset:
"V1 ⊆ V2 ⟹ separated g V2 ⟹ separated g V1"
proof (simp add: separated_def separated⇩3_def separated⇩2_def,
elim conjE, intro allI impI ballI conjI)
fix v f
assume a: "v ∈ V1" "V1 ⊆ V2" "f ∈ set (facesAt g v)"
"|vertices f| ≤ 4"
"∀v∈V2. ∀f∈set (facesAt g v). |vertices f| ≤ 4 ⟶
set (vertices f) ∩ V2 = {v}"
then show "set (vertices f) ∩ V1 = {v}" by auto
next
fix v f
assume a: "v ∈ V1" "V1 ⊆ V2" "f ∈ set (facesAt g v)"
"∀v∈V2. ∀f∈set (facesAt g v). f ∙ v ∉ V2"
then have "v ∈ V2" by auto
with a have "f ∙ v ∉ V2" by auto
with a show "f ∙ v ∉ V1" by auto
qed
end
Theory LowerBound
section ‹Correctness of Lower Bound for Final Graphs›
theory LowerBound
imports PlaneProps ScoreProps
begin
lemma trans1:
"(l::nat) = a1 + a2 + (a3 + a4) ⟹ a1 + a3 = r ⟹ l = r + a2 + a4"
by simp
lemma trans2: "(l::nat) = a1 + a2 + a3 ⟹ a1 ≤ r ⟹ l ≤ r + a2 + a3"
by simp
lemma trans3:
"(l::nat) ≤ a1 + a2 + (a3 + a4) ⟹ a2 + a3 ≤ r ⟹ l ≤ a1 + r + a4"
by simp
lemma trans4: "(l::nat) ≤ a1 + a2 + a3 ⟹ a3 ≤ r ⟹ l ≤ a1 + a2 + r"
by simp
lemma trans5: "(l::nat) ≤ a1 + a2 + a3 ⟹ a2 + a3 = r ⟹ l ≤ a1 + r"
by simp
lemma trans6: "(a::nat) = b1 + (b2 + b3) + b4 ⟹ b3 = 0 ⟹
a = b1 + b2 + b4" by (simp add: ac_simps)
theorem total_weight_lowerbound:
"inv g ⟹ final g ⟹ tame g ⟹ admissible w g ⟹
(∑⇘f ∈ faces g⇙ w f) < squanderTarget ⟹
squanderLowerBound g ≤ (∑⇘f ∈ faces g⇙ w f)"
proof -
assume final: "final g" and tame: "tame g" and pl: "inv g"
assume admissible: "admissible w g"
assume w: "(∑⇘f ∈ faces g⇙ w f) < squanderTarget"
from admissible have admissible⇩1:
"⋀f. f ∈ set (faces g) ⟹ 𝖽 |vertices f| ≤ w f"
by (simp add: admissible_def admissible⇩1_def)
have "squanderLowerBound g
= ExcessNotAt g None + faceSquanderLowerBound g"
by (simp add: squanderLowerBound_def)
txt ‹We expand the definition of ‹faceSquanderLowerBound›.›
also have "faceSquanderLowerBound g = (∑⇘f ∈ faces g⇙ 𝖽 |vertices f| )"
by (simp add: faceSquanderLowerBound_def final)
txt ‹We expand the definition of ‹ExcessNotAt›.›
also from ExcessNotAt_eq[OF pl[THEN inv_mgp] final] obtain V
where eq: "ExcessNotAt g None = (∑⇘v ∈ V⇙ ExcessAt g v)"
and pS: "separated g (set V)"
and V_subset: "set V ⊆ set(vertices g)"
and V_distinct: "distinct V"
by (blast) note eq
txt ‹We partition V in two disjoint subsets $V1, V2$,
where $V2$ contains all exceptional vertices, $V1$ all
not exceptional vertices.›
also
define V1 where "V1 = [v ← V. except g v = 0]"
define V2 where "V2 = [v ← V. except g v ≠ 0]"
have s: "set V1 ⊆ set V" by (auto simp add: V1_def)
with pS obtain pSV1: "separated g (set V1)"
by (auto dest: separated_subset)
from V_distinct obtain V1_distinct: "distinct V1"
by (unfold V1_def) (auto dest: distinct_filter)
obtain noExV1: "noExceptionals g (set V1)"
by (auto simp add: V1_def noExceptionals_def
exceptionalVertex_def)
have V_subset_simp: "⋀v. v: set V ⟹ v : 𝒱 g"
using V_subset by fast
have "(∑⇘v ∈ V⇙ ExcessAt g v)
= (∑⇘v ∈ V1⇙ ExcessAt g v) + (∑⇘v ∈ V2⇙ ExcessAt g v)"
by (simp only: V1_def V2_def ListSum_compl)
txt ‹We partition ‹V2› in two disjoint subsets,
$V4$ contains all exceptional vertices of degree $\neq 5$
$V3$ contains all exceptional vertices of degree $5$.
›
also
define V4 where "V4 = [v ← V2. vertextype g v ≠ (5,0,1)]"
define V3 where "V3 = [v ← V2. vertextype g v = (5,0,1)]"
with pS V2_def have V3: "separated g (set V3)"
by (rule_tac separated_subset) auto
have "distinct V3" by(simp add:V3_def V2_def ‹distinct V›)
from V_subset obtain V3_subset: "set V3 ⊆ 𝒱 g"
by (auto simp add: V3_def V2_def)
have "(∑⇘v ∈ V2⇙ ExcessAt g v)
= (∑⇘v ∈ V3⇙ ExcessAt g v) + (∑⇘v ∈ V4⇙ ExcessAt g v)"
by (simp add: V4_def V3_def ListSum_compl)
txt ‹We partition ‹faces g› in two disjoint subsets:
$F1$ contains all faces that contain a vertex of $V1$,
$F2$ the remaining faces.›
also
define F1 where "F1 = [f ← faces g . ∃ v ∈ set V1. f ∈ set (facesAt g v)]"
define F2 where "F2 = [f ← faces g . ¬(∃ v ∈ set V1. f ∈ set (facesAt g v))]"
have "(∑⇘f ∈ faces g⇙ 𝖽 |vertices f| )
= (∑⇘f ∈ F1⇙ 𝖽 |vertices f| ) + (∑⇘ f ∈ F2⇙ 𝖽 |vertices f| )"
by (simp only: ListSum_compl F1_def F2_def)
txt ‹We split up ‹F2› in two disjoint subsets:›
also
define F3 where "F3 = [f←F2. ∃v ∈ set V3. f ∈ set (facesAt g v)]"
define F4 where "F4 = [f←F2. ¬ (∃v ∈ set V3. f ∈ set (facesAt g v))]"
have F3: "F3 = [f←faces g . ∃v ∈ set V3. f ∈ set (facesAt g v)]"
proof(simp add: F3_def F2_def, intro filter_eqI iffI conjI)
fix f assume "f ∈ set (faces g)"
with final have fin: "final f" by (rule finalGraph_face)
assume "∃v3∈set V3. f ∈ set (facesAt g v3)"
then obtain v3 where v3: "v3 ∈ set V3" "f ∈ set (facesAt g v3)"
by auto
show "(∀v1∈set V1. f ∉ set (facesAt g v1))"
proof (intro ballI notI)
fix v1 assume v1: "v1 ∈ set V1"
with v3 have "v1 ≠ v3"
by (auto simp add: V3_def V2_def V1_def)
moreover assume f: "f ∈ set (facesAt g v1)"
with v1 fin have c: "|vertices f| ≤ 4"
by (auto simp add: V1_def except_def)
from v1 have "v1 ∈ set V" by (simp add: V1_def)
with f pS c have "set (vertices f) ∩ set V = {v1}"
by (simp add: separated_def separated⇩3_def)
moreover from v3 have "v3 ∈ set V"
by (simp add: V3_def V2_def)
with v3 pS c have "set (vertices f) ∩ set V = {v3}"
by (simp add: separated_def separated⇩3_def)
ultimately show False by auto
qed
qed simp
have "(∑⇘f∈F2⇙ 𝖽 |vertices f| )
= (∑⇘f∈F3⇙ 𝖽 |vertices f| ) + (∑⇘f∈F4⇙ 𝖽 |vertices f| )"
by (simp only: F3_def F4_def ListSum_compl)
text_raw ‹\newpage›
txt ‹($E_1$) From the definition of ‹ExcessAt› we have›
also have "(∑⇘v ∈ V1⇙ ExcessAt g v) + (∑⇘ f ∈ F1⇙ 𝖽 |vertices f| )
= (∑⇘v ∈ V1⇙ 𝖻 (tri g v) (quad g v))"
proof -
from noExV1 V_subset have "(∑⇘ f ∈ F1⇙ 𝖽 |vertices f| )
= (∑⇘v ∈ V1⇙ (tri g v * 𝖽 3 + quad g v * 𝖽 4))"
apply (unfold F1_def)
apply (rule_tac squanderFace_distr2)
apply (rule pl)
apply (rule final)
apply (rule noExV1)
apply (rule pSV1)
apply (rule V1_distinct)
apply (unfold V1_def)
apply auto
done
also have "(∑⇘v ∈ V1⇙ ExcessAt g v)
+ (∑⇘v ∈ V1⇙ (tri g v * 𝖽 3 + quad g v * 𝖽 4))
= (∑⇘v ∈ V1⇙ (ExcessAt g v
+ tri g v * 𝖽 3 + quad g v * 𝖽 4))"
by (simp add: ListSum_add ac_simps)
also from pl final tame have "… = (∑⇘v ∈ V1⇙ 𝖻 (tri g v) (quad g v))"
by (rule_tac ListSum_eq)
(fastforce simp add: V1_def V_subset[THEN subsetD] intro: excess_eq1)
finally show ?thesis .
qed
txt ‹($E_2$) For all exceptional vertices of degree $5$
‹excess› returns ‹a (tri g v)›.›
also (trans1)
from pl final V_subset have
"(∑⇘v ∈ V3⇙ ExcessAt g v) = (∑⇘v ∈ V3⇙ 𝖺)"
apply (rule_tac ListSum_eq)
apply (simp add: V3_def V2_def excessAtType_def ExcessAt_def degree_eq vertextype_def)
by(blast intro: finalVertexI)
txt ‹($E_3$) For all exceptional vertices of degree $\neq 5$
‹ExcessAt› returns 0.›
also from pl final tame have "(∑⇘v ∈ V4⇙ ExcessAt g v) = (∑⇘v ∈ V4⇙ 0)"
by (rule_tac ListSum_eq)
(auto simp: V2_def V4_def excessAtType_def ExcessAt_def degree_eq V_subset_simp tame_def tame12o_def)
also have "… = 0" by simp
txt ‹($A_1$) We use property ‹admissible⇩2›.›
also(trans6) have
"(∑⇘v ∈ V1⇙ 𝖻 (tri g v) (quad g v)) ≤ (∑⇘v ∈ V1⇙ ∑⇘f ∈ facesAt g v⇙ w f)"
proof (rule_tac ListSum_le)
fix v assume "v ∈ set V1"
with V1_def V_subset have "v ∈ set (vertices g)" by auto
with admissible show "𝖻 (tri g v) (quad g v) ≤ (∑⇘f ∈ facesAt g v⇙ w f)"
using ‹v ∈ set V1› by (auto simp add:admissible_def admissible⇩2_def V1_def)
qed
also(trans2) from pSV1 V1_distinct V_subset have "… = (∑⇘f ∈ F1⇙ w f)"
apply (unfold F1_def)
apply (rule ScoreProps.separated_disj_Union2)
apply (rule pl)
apply (rule final)
apply (rule noExV1)
apply (rule pSV1)
apply (rule V1_distinct)
apply (unfold V1_def)
apply auto
done
txt ‹($A_2$) We use property ‹admissible⇩4›.›
also have "(∑⇘v∈V3⇙ 𝖺) + (∑⇘f∈F3⇙ 𝖽 |vertices f| ) ≤ (∑⇘f ∈ F3 ⇙w f)"
proof-
define T where "T = [f←F3. triangle f]"
define E where "E = [f←F3. ¬ triangle f]"
have "(∑⇘f∈F3⇙ 𝖽 |vertices f| ) =
(∑⇘f∈T⇙ 𝖽 |vertices f| ) + (∑⇘f∈E⇙ 𝖽 |vertices f| )"
by(simp only: T_def E_def ListSum_compl2)
also have "(∑⇘f∈T⇙ 𝖽 |vertices f| ) =
(∑⇘f ∈ [f←faces g . ∃v ∈ set V3. f ∈ set (facesAt g v) ∩ Collect triangle]⇙ 𝖽 |vertices f| )"
by(rule listsum_cong[OF _ HOL.refl])
(simp add:T_def F3 Int_def)
also have "… = (∑⇘v ∈ V3⇙ ∑⇘f ∈ filter triangle (facesAt g v)⇙ 𝖽 |vertices f| )"
by(rule ListSum_V_F_eq_ListSum_F[symmetric, OF ‹inv g› V3 ‹distinct V3› ‹set V3 ⊆ 𝒱 g›])
(simp add:Ball_def)
also have "… = 0" by (simp add: squanderFace_def)
finally have "(∑⇘v∈V3⇙ 𝖺) + (∑⇘f∈F3⇙ 𝖽 |vertices f| ) =
(∑⇘v∈V3⇙ 𝖺) + (∑⇘f∈E⇙ 𝖽 |vertices f| )" by simp
also have "(∑⇘f∈E⇙ 𝖽 |vertices f| ) ≤ (∑⇘f∈E⇙ w f )"
using ‹admissible w g›
by(rule_tac ListSum_le)
(simp add: admissible_def admissible⇩1_def E_def F3_def F2_def)
also have "(∑⇘v∈V3⇙ 𝖺) ≤ (∑⇘v∈V3⇙ ∑⇘f∈filter triangle (facesAt g v)⇙ w(f))"
using ‹admissible w g›
by(rule_tac ListSum_le)
(simp add: admissible_def admissible⇩3_def V3_def V2_def V_subset_simp)
also have "… = (∑⇘f ∈ [f←faces g . ∃v ∈ set V3. f ∈ set (facesAt g v) ∩ Collect triangle]⇙ w f)"
by(rule ListSum_V_F_eq_ListSum_F[OF ‹inv g› V3 ‹distinct V3› ‹set V3 ⊆ 𝒱 g›])
(simp add:Ball_def)
also have "… = (∑⇘f∈T⇙ w f)"
by(simp add: T_def F3 Int_def)
also have "ListSum T w + ListSum E w = ListSum F3 w"
by(simp add: T_def E_def ListSum_compl2)
finally show ?thesis by simp
qed
text_raw ‹\newpage›
txt ‹($A_3$) We use property ‹admissible⇩1›.›
also(trans3) have "(∑⇘ f ∈ F4⇙ 𝖽 |vertices f| ) ≤ (∑⇘f ∈ F4⇙ w f)"
proof (rule ListSum_le)
fix f assume "f ∈ set F4"
then have f: "f ∈ set (faces g)" by (simp add: F4_def F2_def)
with admissible⇩1 f show "𝖽 |vertices f| ≤ w f" by (simp)
qed
txt ‹We reunite $F3$ and $F4$.›
also(trans4) have "(∑⇘ f ∈ F3⇙ w f) + (∑⇘ f ∈ F4⇙ w f) = (∑⇘ f ∈ F2⇙ w f)"
by (simp only: F3_def F4_def ListSum_compl)
txt ‹We reunite $F1$ and $F2$.›
also(trans5) have "(∑⇘ f ∈ F1⇙ w f) + (∑⇘ f ∈ F2⇙ w f) = (∑⇘f ∈ faces g⇙ w f)"
by (simp only: F1_def F2_def ListSum_compl)
finally show "squanderLowerBound g ≤ (∑⇘f ∈ faces g⇙ w f)" .
qed
end
Theory GeneratorProps
section "Properties of Tame Graph Enumeration (1)"
theory GeneratorProps
imports Plane1Props Generator TameProps LowerBound
begin
lemma genPolyTame_spec:
"generatePolygonTame n v f g = [g' ← generatePolygon n v f g . ¬ notame g']"
by(simp add:generatePolygonTame_def generatePolygon_def enum_enumerator)
lemma genPolyTame_subset_genPoly:
"g' ∈ set(generatePolygonTame i v f g) ⟹
g' ∈ set(generatePolygon i v f g)"
by(auto simp add:generatePolygon_def generatePolygonTame_def enum_enumerator)
lemma next_tame0_subset_plane:
"set(next_tame0 p g) ⊆ set(next_plane p g)"
by(auto simp add:next_tame0_def next_plane_def polysizes_def
elim!:genPolyTame_subset_genPoly simp del:upt_Suc)
lemma genPoly_new_face:
"⟦g' ∈ set (generatePolygon n v f g); minGraphProps g; f ∈ set (nonFinals g);
v ∈ 𝒱 f; n ≥ 3 ⟧ ⟹
∃f ∈ set(finals g') - set(finals g). |vertices f| = n"
apply(auto simp add:generatePolygon_def image_def)
apply(rename_tac "is")
apply(frule enumerator_length2)
apply arith
apply(frule (4) pre_subdivFace_indexToVertexList)
apply(arith)
apply(subgoal_tac "indexToVertexList f v is ≠ []")
prefer 2 apply(subst length_0_conv[symmetric]) apply simp
apply(simp add: subdivFace_subdivFace'_eq)
apply(clarsimp simp:neq_Nil_conv)
apply(rename_tac "ovs")
apply(subgoal_tac "|indexToVertexList f v is| = |ovs| + 1")
prefer 2 apply(simp)
apply(drule (1) pre_subdivFace_pre_subdivFace')
apply(drule (1) final_subdivFace')
apply(simp add:nonFinals_def)
apply(simp add:pre_subdivFace'_def)
apply (simp (no_asm_use))
apply(simp)
apply blast
done
lemma genPoly_incr_facesquander_lb:
assumes "g' ∈ set (generatePolygon n v f g)" "inv g"
"f ∈ set(nonFinals g)" "v ∈ 𝒱 f" "3 ≤ n"
shows "faceSquanderLowerBound g' ≥ faceSquanderLowerBound g + 𝖽 n"
proof -
from genPoly_new_face[OF assms(1) inv_mgp[OF assms(2)] assms(3-5)] obtain f
where f: "f ∈ set (finals g') - set(finals g)"
and size: "|vertices f| = n" by auto
have g': "g' ∈ set(next_plane0 (n - 3) g)" using assms(5)
by(rule_tac in_next_plane0I[OF assms(1,3-5)]) simp
note dist = minGraphProps11'[OF inv_mgp[OF assms(2)]]
note inv' = invariantE[OF inv_inv_next_plane0, OF g' assms(2)]
note dist' = minGraphProps11'[OF inv_mgp[OF inv']]
note subset = next_plane0_finals_subset[OF g']
have "faceSquanderLowerBound g' ≥
faceSquanderLowerBound g + 𝖽 |vertices f|"
proof(unfold faceSquanderLowerBound_def)
have "(∑⇘f∈finals g⇙ 𝖽 |vertices f| ) + 𝖽 |vertices f| =
(∑f∈set(finals g). 𝖽 |vertices f| ) + 𝖽 |vertices f|"
using dist by(simp add:finals_def ListSum_conv_sum)
also have "… = (∑f∈set(finals g) ∪ {f}. 𝖽 |vertices f| )"
using f by simp
also have "… ≤ (∑f∈set(finals g'). 𝖽 |vertices f| )"
using f subset by(fastforce intro!: sum_mono2)
also have "… = (∑⇘f∈finals g'⇙ 𝖽 |vertices f| )"
using dist' by(simp add:finals_def ListSum_conv_sum)
finally show "(∑⇘f∈finals g⇙ 𝖽 |vertices f| ) + 𝖽 |vertices f|
≤ (∑⇘f∈finals g'⇙ 𝖽 |vertices f| )" .
qed
with size show ?thesis by blast
qed
definition close :: "graph ⇒ vertex ⇒ vertex ⇒ bool" where
"close g u v ≡
∃f ∈ set(facesAt g u). if |vertices f| = 4 then v = f ∙ u ∨ v = f ∙ (f ∙ u)
else v = f ∙ u"
lemma delAround_def: "deleteAround g u ps = [p ← ps. ¬ close g u (fst p)]"
by (induct ps) (auto simp: deleteAroundCons close_def)
lemma close_sym: assumes mgp: "minGraphProps g" and ug: "u : 𝒱 g" and cl: "close g u v"
shows "close g v u"
proof -
obtain f where f: "f ∈ set(facesAt g u)" and
"if": "if |vertices f| = 4 then v = f ∙ u ∨ v = f ∙ (f ∙ u) else v = f ∙ u"
using cl by (unfold close_def) blast
note uf = minGraphProps6[OF mgp ug f]
note distf = minGraphProps3[OF mgp minGraphProps5[OF mgp ug f]]
show ?thesis
proof cases
assume 4: "|vertices f| = 4"
hence "v = f ∙ u ∨ v = f ∙ (f ∙ u)" using "if" by simp
thus ?thesis
proof
assume "v = f ∙ u"
then obtain f' where "f' ∈ set(facesAt g v)" "f' ∙ v = u"
using mgp_nextVertex_face_ex2[OF mgp ug f] by blast
thus ?thesis by(auto simp:close_def)
next
assume v: "v = f ∙ (f ∙ u)"
hence "f ∙ (f ∙ v) = u" using quad_next4_id[OF 4 distf uf] by simp
moreover have "f ∈ set(facesAt g v)" using v uf
by(simp add: minGraphProps7[OF mgp minGraphProps5[OF mgp ug f]])
ultimately show ?thesis using 4 by(auto simp:close_def)
qed
next
assume "|vertices f| ≠ 4"
hence "v = f ∙ u" using "if" by simp
then obtain f' where "f' ∈ set(facesAt g v)" "f' ∙ v = u"
using mgp_nextVertex_face_ex2[OF mgp ug f] by blast
thus ?thesis by(auto simp:close_def)
qed
qed
lemma sep_conv:
assumes mgp: "minGraphProps g" and "V ⊆ 𝒱 g"
shows "separated g V = (∀u∈V.∀v∈V. u ≠ v ⟶ ¬ close g u v)" (is "?P = ?Q")
proof
assume sep: ?P
show ?Q
proof(clarify)
fix u v assume uv: "u ∈ V" "v ∈ V" "u ≠ v" and cl: "close g u v"
from cl obtain f where f: "f ∈ set(facesAt g u)" and
"if": "if |vertices f| = 4 then (v = f ∙ u) ∨ (v = f ∙ (f ∙ u))
else (v = f ∙ u)"
by (unfold close_def) blast
have "u : 𝒱 g" using ‹u : V› ‹V ⊆ 𝒱 g› by blast
note uf = minGraphProps6[OF mgp ‹u : 𝒱 g› f]
show False
proof cases
assume 4: "|vertices f| = 4"
hence "v = f ∙ u ∨ v = f ∙ (f ∙ u)" using "if" by simp
thus False
proof
assume "v = f ∙ u"
thus False using sep f uv
by(simp add:separated_def separated⇩2_def separated⇩3_def)
next
assume "v = f ∙ (f ∙ u)"
moreover hence "v ∈ 𝒱 f" using ‹u ∈ 𝒱 f› by simp
moreover have "|vertices f| ≤ 4" using 4 by arith
ultimately show False using sep f uv ‹u ∈ 𝒱 f›
apply(unfold separated_def separated⇩2_def separated⇩3_def)
apply(subgoal_tac "f ∙ (f ∙ u) ∈ 𝒱 f ∩ V")
prefer 2 apply blast
by simp
qed
next
assume 4: "|vertices f| ≠ 4"
hence "v = f ∙ u" using "if" by simp
thus False using sep f uv
by(simp add:separated_def separated⇩2_def separated⇩3_def)
qed
qed
next
assume not_cl: ?Q
show ?P
proof(simp add:separated_def, rule conjI)
show "separated⇩2 g V"
proof (clarsimp simp:separated⇩2_def)
fix v f assume a: "v ∈ V" "f ∈ set (facesAt g v)" "f ∙ v ∈ V"
have "v : 𝒱 g" using a(1) ‹V ⊆ 𝒱 g› by blast
show False using a not_cl mgp_facesAt_no_loop[OF mgp ‹v : 𝒱 g› a(2)]
by(fastforce simp: close_def split:if_split_asm)
qed
show "separated⇩3 g V"
proof (clarsimp simp:separated⇩3_def)
fix v f
assume "v ∈ V" and f: "f ∈ set (facesAt g v)" and len: "|vertices f| ≤ 4"
have vg: "v : 𝒱 g" using ‹v : V› ‹V ⊆ 𝒱 g› by blast
note distf = minGraphProps3[OF mgp minGraphProps5[OF mgp vg f]]
note vf = minGraphProps6[OF mgp vg f]
{ fix u assume "u ∈ 𝒱 f" and "u ∈ V"
have "u = v"
proof cases
assume 3: "|vertices f| = 3"
hence "𝒱 f = {v, f ∙ v, f ∙ (f ∙ v)}"
using vertices_triangle[OF _ vf distf] by simp
moreover
{ assume "u = f ∙ v"
hence "u = v"
using not_cl f ‹u ∈ V› ‹v ∈ V› 3
by(force simp:close_def split:if_split_asm)
}
moreover
{ assume "u = f ∙ (f ∙ v)"
hence fu: "f ∙ u = v"
by(simp add: tri_next3_id[OF 3 distf ‹v ∈ 𝒱 f›])
hence "(u,v) ∈ ℰ f" using nextVertex_in_edges[OF ‹u ∈ 𝒱 f›]
by(simp add:fu)
then obtain f' where "f' ∈ set(facesAt g v)" "(v,u) ∈ ℰ f'"
using mgp_edge_face_ex[OF mgp vg f] by blast
hence "u = v" using not_cl ‹u ∈ V› ‹v ∈ V› 3
by(force simp:close_def edges_face_eq split:if_split_asm)
}
ultimately show "u=v" using ‹u ∈ 𝒱 f› by blast
next
assume 3: "|vertices f| ≠ 3"
hence 4: "|vertices f| = 4"
using len mgp_vertices3[OF mgp minGraphProps5[OF mgp vg f]] by arith
hence "𝒱 f = {v, f ∙ v, f ∙ (f ∙ v), f ∙ (f ∙ (f ∙ v))}"
using vertices_quad[OF _ vf distf] by simp
moreover
{ assume "u = f ∙ v"
hence "u = v"
using not_cl f ‹u ∈ V› ‹v ∈ V› 4
by(force simp:close_def split:if_split_asm)
}
moreover
{ assume "u = f ∙ (f ∙ v)"
hence "u = v"
using not_cl f ‹u ∈ V› ‹v ∈ V› 4
by(force simp:close_def split:if_split_asm)
}
moreover
{ assume "u = f ∙ (f ∙ (f ∙ v))"
hence fu: "f ∙ u = v"
by(simp add: quad_next4_id[OF 4 distf ‹v ∈ 𝒱 f›])
hence "(u,v) ∈ ℰ f" using nextVertex_in_edges[OF ‹u ∈ 𝒱 f›]
by(simp add:fu)
then obtain f' where "f' ∈ set(facesAt g v)" "(v,u) ∈ ℰ f'"
using mgp_edge_face_ex[OF mgp vg f] by blast
hence "u = v" using not_cl ‹u ∈ V› ‹v ∈ V› 4
by(force simp:close_def edges_face_eq split:if_split_asm)
}
ultimately show "u=v" using ‹u ∈ 𝒱 f› by blast
qed
}
thus "𝒱 f ∩ V = {v}" using ‹v ∈ V› vf by blast
qed
qed
qed
lemma sep_ne: "∃P ⊆ M. separated g (fst ` P)"
by(unfold separated_def separated⇩2_def separated⇩3_def) blast
lemma ExcessNotAtRec_conv_Max:
assumes mgp: "minGraphProps g"
shows "set(map fst ps) ⊆ 𝒱 g ⟹ distinct(map fst ps) ⟹
ExcessNotAtRec ps g =
Max{ ∑p∈P. snd p |P. P ⊆ set ps ∧ separated g (fst ` P)}"
(is "_ ⟹ _ ⟹ _ = Max(?M ps)" is "_ ⟹ _ ⟹ _ = Max{_ |P. ?S ps P}")
proof(induct ps rule: length_induct)
case (1 ps0)
note IH = 1(1) and subset = 1(2) and dist = 1(3)
show ?case
proof (cases ps0)
case Nil thus ?thesis by simp
next
case (Cons p ps)
let ?ps = "deleteAround g (fst p) ps"
have le: "|?ps| ≤ |ps|" by(simp add:delAround_def)
have dist': "distinct(map fst ?ps)" using dist Cons
apply (clarsimp simp:delAround_def)
apply(drule distinct_filter[where P = "Not ∘ close g (fst p)"])
apply(simp add: filter_map o_def)
done
have "fst p : 𝒱 g" and "fst ` set ps ⊆ 𝒱 g"
using subset Cons by auto
have sub1: "⋀P Q. P ⊆ {x : set ps. Q x} ⟹ fst ` P ⊆ 𝒱 g"
using subset Cons by auto
have sub2: "⋀P Q. P ⊆ insert p {x : set ps. Q x} ⟹ fst ` P ⊆ 𝒱 g"
using subset Cons by auto
have sub3: "⋀P. P ⊆ insert p (set ps) ⟹ fst ` P ⊆ 𝒱 g"
using subset Cons by auto
have "⋀a. set (map fst (deleteAround g a ps)) ⊆ 𝒱 g"
using deleteAround_subset[of g _ ps] subset Cons
by auto
hence "ExcessNotAtRec ps0 g = max (Max(?M ps)) (Max(?M ?ps) + snd p)"
using Cons IH subset le dist dist' by (cases p) simp
also have "Max (?M ?ps) + snd p =
Max {(∑p∈P. snd p) + snd p | P. ?S ?ps P}"
by (auto simp add:setcompr_eq_image Max_add_commute[symmetric] sep_ne intro!: arg_cong [where f=Max])
also have "{(∑p∈P. snd p) + snd p |P. ?S ?ps P} =
{sum snd (insert p P) |P. ?S ?ps P}"
using dist Cons
apply (auto simp:delAround_def)
apply(rule_tac x=P in exI)
apply(fastforce intro!: sum.insert[THEN trans,symmetric] elim: finite_subset)
apply(rule_tac x=P in exI)
apply(fastforce intro!: sum.insert[THEN trans] elim: finite_subset)
done
also have "… = {sum snd P |P.
P ⊆ insert p (set ?ps) ∧ p ∈ P ∧ separated g (fst ` P)}"
apply(auto simp add:sep_conv[OF mgp] sub1 sub2 delAround_def cong: conj_cong)
apply(rule_tac x = "insert p P" in exI)
apply simp
apply(rule conjI) apply blast
using ‹image fst (set ps) ⊆ 𝒱 g› ‹fst p : 𝒱 g›
apply (blast intro:close_sym[OF mgp])
apply(rule_tac x = "P-{p}" in exI)
apply (simp add:insert_absorb)
apply blast
done
also have "… = {sum snd P |P.
P ⊆ insert p (set ps) ∧ p ∈ P ∧ separated g (fst ` P)}"
using Cons dist
apply(auto simp add:sep_conv[OF mgp] sub2 sub3 delAround_def cong: conj_cong)
apply(rule_tac x = "P" in exI)
apply simp
apply auto
done
also have "max (Max(?M ps)) (Max …) = Max(?M ps ∪ {sum snd P |P.
P ⊆ insert p (set ps) ∧ p ∈ P ∧ separated g (fst ` P)})"
(is "_ = Max ?U")
proof -
have "{sum snd P |P.
P ⊆ insert p (set ps) ∧ p ∈ P ∧ separated g (fst ` P)} ≠ {}"
apply simp
apply(rule_tac x="{p}" in exI)
using ‹fst p : 𝒱 g› by(simp add:sep_conv[OF mgp])
thus ?thesis by(simp add: Max_Un sep_ne)
qed
also have "?U = ?M ps0" using Cons by simp blast
finally show ?thesis .
qed
qed
lemma dist_ExcessTab: "distinct (map fst (ExcessTable g (vertices g)))"
by(simp add:ExcessTable_def vertices_graph o_def)
lemma mono_ExcessTab: "⟦g' ∈ set (next_plane0⇘p⇙ g); inv g ⟧ ⟹
set(ExcessTable g (vertices g)) ⊆ set(ExcessTable g' (vertices g'))"
apply(clarsimp simp:ExcessTable_def image_def)
apply(rule conjI)
apply(blast dest:next_plane0_vertices_subset inv_mgp)
apply (clarsimp simp:ExcessAt_def split:if_split_asm)
apply(frule (3) next_plane0_finalVertex_mono)
apply(simp add: next_plane0_len_filter_eq tri_def quad_def except_def)
done
lemma close_antimono:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g; u ∈ 𝒱 g; finalVertex g u ⟧ ⟹
close g' u v ⟹ close g u v"
by(simp add:close_def next_plane0_finalVertex_facesAt_eq)
lemma ExcessTab_final:
"p ∈ set(ExcessTable g (vertices g)) ⟹ finalVertex g (fst p)"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)
lemma ExcessTab_vertex:
"p ∈ set(ExcessTable g (vertices g)) ⟹ fst p ∈ 𝒱 g"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)
lemma fst_set_ExcessTable_subset:
"fst ` set (ExcessTable g (vertices g)) ⊆ 𝒱 g"
by(clarsimp simp:ExcessTable_def image_def ExcessAt_def split:if_split_asm)
lemma next_plane0_incr_ExcessNotAt:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g ⟧ ⟹
ExcessNotAt g None ≤ ExcessNotAt g' None"
apply(frule (1) invariantE[OF inv_inv_next_plane0])
apply(frule (1) mono_ExcessTab)
apply(simp add: ExcessNotAt_def ExcessNotAtRec_conv_Max[OF _ _ dist_ExcessTab]
fst_set_ExcessTable_subset)
apply(rule Max_mono)
prefer 2 apply (simp add: sep_ne)
prefer 2 apply (simp)
apply auto
apply(rule_tac x=P in exI)
apply auto
apply(subgoal_tac "fst ` P ⊆ 𝒱 g'")
prefer 2 apply (blast dest: ExcessTab_vertex)
apply(subgoal_tac "fst ` P ⊆ 𝒱 g")
prefer 2 apply (blast dest: ExcessTab_vertex)
apply(simp add:sep_conv)
apply (blast intro:close_antimono ExcessTab_final ExcessTab_vertex)
done
lemma next_plane0_incr_squander_lb:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g ⟧ ⟹
squanderLowerBound g ≤ squanderLowerBound g'"
apply(simp add:squanderLowerBound_def)
apply(frule (1) next_plane0_incr_ExcessNotAt)
apply(clarsimp simp add:next_plane0_def split:if_split_asm)
apply(drule (4) genPoly_incr_facesquander_lb)
apply arith
done
lemma inv_notame:
"⟦g' ∈ set (next_plane0⇘p⇙ g); inv g; notame7 g⟧
⟹ notame7 g'"
apply(simp add:notame_def notame7_def tame11b_def is_tame13a_def tame10ub_def del:disj_not1)
apply(frule inv_mgp)
apply(frule (1) next_plane0_vertices_subset)
apply(erule disjE)
apply(simp add:vertices_graph)
apply(rule disjI2)
apply(erule disjE)
apply clarify
apply(frule (2) next_plane0_incr_degree)
apply(frule (2) next_plane0_incr_except)
apply (force split:if_split_asm)
apply(frule (1) next_plane0_incr_squander_lb)
apply(arith)
done
lemma inv_inv_notame:
"invariant(λg. inv g ∧ notame7 g) next_plane⇘p⇙"
apply(simp add:invariant_def)
apply(blast intro: inv_notame mgp_next_plane0_if_next_plane[OF inv_mgp]
invariantE[OF inv_inv_next_plane])
done
lemma untame_notame:
"untame (λg. inv g ∧ notame7 g)"
proof(clarsimp simp add: notame_def notame7_def untame_def tame11b_def is_tame13a_def tame10ub_def
linorder_not_le linorder_not_less)
fix g assume "final g" "inv g" "tame g"
and cases: "15 < countVertices g ∨
(∃v∈𝒱 g. (except g v = 0 ⟶ 7 < degree g v) ∧
(0 < except g v ⟶ 6 < degree g v))
∨ squanderTarget ≤ squanderLowerBound g"
(is "?A ∨ ?B ∨ ?C" is "_ ∨ (∃v∈𝒱 g. ?B' v) ∨ _")
from cases show False
proof(elim disjE)
assume ?B
then obtain v where v: "v ∈𝒱 g" "?B' v" by auto
show False
proof cases
assume "except g v = 0"
thus False using ‹tame g› v by(auto simp: tame_def tame11b_def)
next
assume "except g v ≠ 0"
thus False using ‹tame g› v
by(auto simp: except_def filter_empty_conv tame_def tame11b_def
minGraphProps_facesAt_eq[OF inv_mgp[OF ‹inv g›]] split:if_split_asm)
qed
next
assume ?A
thus False using ‹tame g› by(simp add:tame_def tame10_def)
next
assume ?C
thus False using total_weight_lowerbound[OF ‹inv g› ‹final g› ‹tame g›]
‹tame g› by(force simp add:tame_def tame13a_def)
qed
qed
lemma polysizes_tame:
"⟦ g' ∈ set (generatePolygon n v f g); inv g; f ∈ set(nonFinals g);
v ∈ 𝒱 f; 3 ≤ n; n < 4+p; n ∉ set(polysizes p g) ⟧
⟹ notame7 g'"
apply(frule (4) in_next_plane0I)
apply(frule (4) genPoly_incr_facesquander_lb)
apply(frule (1) next_plane0_incr_ExcessNotAt)
apply(simp add: notame_def notame7_def is_tame13a_def faceSquanderLowerBound_def
polysizes_def squanderLowerBound_def)
done
lemma genPolyTame_notame:
"⟦ g' ∈ set (generatePolygon n v f g); g' ∉ set (generatePolygonTame n v f g);
inv g; 3 ≤ n ⟧
⟹ notame7 g'"
by(fastforce simp:generatePolygon_def generatePolygonTame_def enum_enumerator
notame_def notame7_def)
declare upt_Suc[simp del]
lemma excess_notame:
"⟦ inv g; g' ∈ set (next_plane⇘p⇙ g); g' ∉ set (next_tame0 p g) ⟧
⟹ notame7 g'"
apply(frule (1) mgp_next_plane0_if_next_plane[OF inv_mgp])
apply(auto simp add:next_tame0_def next_plane_def split:if_split_asm)
apply(rename_tac n)
apply(case_tac "n ∈ set(polysizes p g)")
apply(drule bspec) apply assumption
apply(simp add:genPolyTame_notame)
apply(subgoal_tac "minimalFace (nonFinals g) ∈ set(nonFinals g)")
prefer 2 apply(simp add:minimalFace_def)
apply(subgoal_tac "minimalVertex g (minimalFace (nonFinals g)) ∈ 𝒱(minimalFace (nonFinals g))")
apply(blast intro:polysizes_tame)
apply(simp add:minimalVertex_def)
apply(rule minimal_in_set)
apply(erule mgp_vertices_nonempty[OF inv_mgp])
apply(simp add:nonFinals_def)
done
declare upt_Suc[simp]
lemma next_tame0_comp: "⟦ Seed⇘p⇙ [next_plane p]→* g; final g; tame g ⟧
⟹ Seed⇘p⇙ [next_tame0 p]→* g"
apply(rule filterout_untame_succs[OF inv_inv_next_plane inv_inv_notame
untame_notame])
apply(blast intro:excess_notame)
apply assumption
apply(rule inv_Seed)
apply assumption
apply assumption
done
lemma inv_inv_next_tame0: "invariant inv (next_tame0 p)"
by(rule inv_subset[OF inv_inv_next_plane next_tame0_subset_plane])
lemma inv_inv_next_tame: "invariant inv next_tame⇘p⇙"
apply(simp add:next_tame_def)
apply(rule inv_subset[OF inv_inv_next_tame0])
apply auto
done
lemma mgp_TameEnum: "g ∈ TameEnum⇘p⇙ ⟹ minGraphProps g"
by (unfold TameEnumP_def)
(blast intro: RTranCl_inv[OF inv_inv_next_tame] inv_Seed inv_mgp)
end
Theory TameEnumProps
section "Properties of Tame Graph Enumeration (2)"
theory TameEnumProps
imports GeneratorProps
begin
text‹Completeness of filter for final graphs.›
lemma untame_negFin:
assumes pl: "inv g" and fin: "final g" and tame: "tame g"
shows "is_tame g"
proof (unfold is_tame_def, intro conjI)
show "tame10 g" using tame by(auto simp:tame_def)
next
show "tame11a g" using tame by(auto simp:tame_def)
next
show "tame12o g" using tame by(auto simp:tame_def)
next
next
from tame obtain w where adm: "admissible w g"
and sqn: "(∑⇘f ∈ faces g⇙ w f) < squanderTarget" by(auto simp:tame_def tame13a_def)
moreover have "squanderLowerBound g ≤ (∑⇘f ∈ faces g⇙ w f)"
using pl fin tame adm sqn by (rule total_weight_lowerbound)
ultimately show "is_tame13a g" by(auto simp:is_tame13a_def)
qed
lemma next_tame_comp:
"⟦ tame g; final g; Seed⇘p⇙ [next_tame0 p]→* g ⟧
⟹ Seed⇘p⇙ [next_tame⇘p⇙]→* g"
apply (unfold next_tame_def)
apply(rule filter_tame_succs[OF inv_inv_next_tame0])
apply(simp add:next_tame0_def finalGraph_def)
apply(rule context_conjI)
apply(simp)
apply(blast dest:untame_negFin)
apply assumption
apply(rule inv_Seed)
apply assumption+
done
end
Theory Worklist
theory Worklist
imports "HOL-Library.While_Combinator" RTranCl Quasi_Order
begin
definition
worklist_aux :: "('s ⇒ 'a ⇒ 'a list) ⇒ ('a ⇒ 's ⇒ 's)
⇒ 'a list * 's ⇒ ('a list * 's)option"
where
"worklist_aux succs f =
while_option
(λ(ws,s). ws ≠ [])
(λ(ws,s). case ws of x#ws' ⇒ (succs s x @ ws', f x s))"
definition worklist :: "('s ⇒ 'a ⇒ 'a list) ⇒ ('a ⇒ 's ⇒ 's)
⇒ 'a list ⇒ 's ⇒ 's option" where
"worklist succs f ws s =
(case worklist_aux succs f (ws,s) of
None ⇒ None | Some(ws,s) ⇒ Some s)"
lemma worklist_aux_Nil: "worklist_aux succs f ([],s) = Some([],s)"
by(simp add: worklist_aux_def while_option_unfold)
lemma worklist_aux_Cons:
"worklist_aux succs f (x#ws',s) = worklist_aux succs f (succs s x @ ws', f x s)"
by(simp add: worklist_aux_def while_option_unfold)
lemma worklist_aux_unfold[code]:
"worklist_aux succs f (ws,s) =
(case ws of [] ⇒ Some([],s)
| x#ws' ⇒ worklist_aux succs f (succs s x @ ws', f x s))"
by(simp add: worklist_aux_Nil worklist_aux_Cons split: list.split)
definition
worklist_tree_aux :: "('a ⇒ 'a list) ⇒ ('a ⇒ 's ⇒ 's)
⇒ 'a list * 's ⇒ ('a list * 's)option"
where
"worklist_tree_aux succs = worklist_aux (λs. succs)"
lemma worklist_tree_aux_unfold[code]:
"worklist_tree_aux succs f (ws,s) =
(case ws of [] ⇒ Some([],s) |
x#ws' ⇒ worklist_tree_aux succs f (succs x @ ws', f x s))"
by(simp add: worklist_tree_aux_def worklist_aux_Nil worklist_aux_Cons split: list.split)
abbreviation Rel :: "('a ⇒ 'a list) ⇒ ('a * 'a)set" where
"Rel f == {(x,y). y : set(f x)}"
lemma Image_Rel_set:
"(Rel succs)⇧* `` set(succs x) = (Rel succs)⇧+ `` {x}"
by(auto simp add: trancl_unfold_left)
lemma RTranCl_conv:
"g [succs]→* h ⟷ (g,h) : ((Rel succs)⇧*)" (is "?L = ?R")
proof-
have "?L ⟹ ?R"
apply(erule RTranCl_induct)
apply blast
apply (auto elim: rtrancl_into_rtrancl)
done
moreover
have "?R ⟹ ?L"
apply(erule converse_rtrancl_induct)
apply(rule RTranCl.refl)
apply (auto elim: RTranCl.succs)
done
ultimately show ?thesis by blast
qed
lemma worklist_end_empty:
"worklist_aux succs f (ws,s) = Some(ws',s') ⟹ ws' = []"
unfolding worklist_aux_def
by (drule while_option_stop) simp
theorem worklist_tree_aux_Some_foldl:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
shows "∃rs. set rs = ((Rel succs)⇧*) `` (set ws) ∧
s' = foldl (λs x. f x s) s rs"
proof -
let ?b = "λ(ws,s). ws ≠ []"
let ?c = "λ(ws,s). case ws of x#ws' ⇒ (succs x @ ws', f x s)"
let ?Q = "λws' s' done.
s' = foldl (λx s. f s x) s done ∧
((Rel succs)⇧*) `` (set ws) =
set done ∪ ((Rel succs)⇧*) `` set ws'"
let ?P = "λ(ws,s). ∃done. ?Q ws s done"
have 0: "while_option ?b ?c (ws,s) = Some(ws',s')"
using assms by(simp add: worklist_tree_aux_def worklist_aux_def)
from while_option_stop[OF 0] have "ws' = []" by simp
have init: "?P (ws,s)"
apply auto
apply(rule_tac x = "[]" in exI)
apply simp
done
{ fix ws s
assume "?P (ws,s)"
then obtain "done" where "?Q ws s done" by blast
assume "?b(ws,s)"
then obtain x ws' where "ws = x # ws'" by(auto simp: neq_Nil_conv)
then have "?Q (succs x @ ws') (f x s) (done @ [x])"
using ‹?Q ws s done›
apply simp
apply(erule thin_rl)+
apply (auto simp add: Image_Un Image_Rel_set)
apply (blast elim: rtranclE intro: rtrancl_into_trancl1)
done
hence "?P(?c(ws,s))" using ‹ws=x#ws'›
by(simp only: split_conv list.cases) blast
}
then have "?P(ws',s')"
using while_option_rule[where P="?P", OF _ 0 init]
by auto
then show ?thesis using ‹ws'=[]› by auto
qed
definition "worklist_tree succs f ws s =
(case worklist_tree_aux succs f (ws,s) of
None ⇒ None | Some(ws,s) ⇒ Some s)"
theorem worklist_tree_Some_foldl:
"worklist_tree succs f ws s = Some s' ⟹
∃rs. set rs = ((Rel succs)⇧*) `` (set ws) ∧
s' = foldl (λs x. f x s) s rs"
by(simp add: worklist_tree_def worklist_tree_aux_Some_foldl split:option.splits prod.splits)
lemma invariant_succs:
assumes "invariant I succs"
and "∀x∈S. I x"
shows "∀x ∈ (Rel succs)⇧* `` S. I x"
proof-
{ fix x y have "(x,y) : (Rel succs)⇧* ⟹ I x ⟹ I y"
proof(induct rule:rtrancl_induct)
case base thus ?case .
next
case step with assms(1) show ?case by(auto simp:invariant_def)
qed
} with assms(2) show ?thesis by blast
qed
lemma worklist_tree_aux_rule:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "∀x ∈ set ws. I x"
and "⋀s. P [] s s"
and "⋀r x ws s. I x ⟹ ∀x ∈ set ws. I x ⟹ P ws (f x s) r ⟹ P (x#ws) s r"
shows "∃rs. set rs = ((Rel succs)⇧* ) `` (set ws) ∧ P rs s s'"
proof-
let ?R = "(Rel succs)⇧* `` set ws"
from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
rs: "set rs = ?R" "s' = foldl (λs x. f x s) s rs" by blast
{ fix xs have "(∀x ∈ set xs. I x) ⟹ P xs s (foldl (λs x. f x s) s xs)"
proof(induct xs arbitrary: s)
case Nil show ?case using assms(4) by simp
next
case Cons thus ?case using assms(5) by simp
qed
}
with invariant_succs[OF assms(2,3)] show ?thesis by (metis rs)
qed
lemma worklist_tree_aux_rule2:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "∀x ∈ set ws. I x"
and "S s" and "⋀x s. I x ⟹ S s ⟹ S(f x s)"
and "⋀s. P [] s s"
and "⋀r x ws s. I x ⟹ ∀x ∈ set ws. I x ⟹ S s
⟹ P ws (f x s) r ⟹ P (x#ws) s r"
shows "∃rs. set rs = ((Rel succs)⇧*) `` (set ws) ∧ P rs s s'"
proof-
let ?R = "(Rel succs)⇧* `` set ws"
from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
rs: "set rs = ?R" "s' = foldl (λs x. f x s) s rs" by blast
{ fix xs have "(∀x ∈ set xs. I x) ⟹ S s ⟹ P xs s (foldl (λs x. f x s) s xs)"
proof(induct xs arbitrary: s)
case Nil show ?case using assms(6) by simp
next
case Cons thus ?case using assms(5,7) by simp
qed
}
with invariant_succs[OF assms(2,3)] assms(4) show ?thesis by (metis rs)
qed
lemma worklist_tree_rule:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "∀x ∈ set ws. I x"
and "⋀s. P [] s s"
and "⋀r x ws s. I x ⟹ ∀x ∈ set ws. I x ⟹ P ws (f x s) r ⟹ P (x#ws) s r"
shows "∃rs. set rs = ((Rel succs)⇧*) `` (set ws) ∧ P rs s s'"
proof-
obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
from worklist_tree_aux_rule[where P=P,OF this assms(2-5)] show ?thesis by blast
qed
lemma worklist_tree_rule2:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "∀x ∈ set ws. I x"
and "S s" and "⋀x s. I x ⟹ S s ⟹ S(f x s)"
and "⋀s. P [] s s"
and "⋀r x ws s. I x ⟹ ∀x ∈ set ws. I x ⟹ S s
⟹ P ws (f x s) r ⟹ P (x#ws) s r"
shows "∃rs. set rs = ((Rel succs)⇧*) `` (set ws) ∧ P rs s s'"
proof-
obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
from worklist_tree_aux_rule2[where P=P and S=S,OF this assms(2-7)]
show ?thesis by blast
qed
lemma worklist_tree_aux_state_inv:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "I s"
and "⋀x s. I s ⟹ I(f x s)"
shows "I s'"
proof-
from worklist_tree_aux_rule[where P="λws s s'. I s ⟶ I s'" and I="λx. True",
OF assms(1)] assms(2-3)
show ?thesis by(auto simp: invariant_def)
qed
lemma worklist_tree_state_inv:
"worklist_tree succs f ws s = Some(s')
⟹ I s ⟹ (⋀x s. I s ⟹ I(f x s)) ⟹ I s'"
unfolding worklist_tree_def
by(auto intro: worklist_tree_aux_state_inv split: option.splits)
locale set_modulo = quasi_order +
fixes empty :: "'s"
and insert_mod :: "'a ⇒ 's ⇒ 's"
and set_of :: "'s ⇒ 'a set"
and I :: "'a ⇒ bool"
and S :: "'s ⇒ bool"
assumes set_of_empty: "set_of empty = {}"
and set_of_insert_mod: "I x ⟹ S s ∧ (∀x ∈ set_of s. I x)
⟹
set_of(insert_mod x s) = insert x (set_of s) ∨
(∃y ∈ set_of s. x ≼ y) ∧ set_of (insert_mod x s) = set_of s"
and S_empty: "S empty"
and S_insert_mod: "S s ⟹ S (insert_mod x s)"
begin
definition insert_mod2 :: "('b ⇒ bool) ⇒ ('b ⇒ 'a) ⇒ 'b ⇒ 's ⇒ 's" where
"insert_mod2 P f x s = (if P x then insert_mod (f x) s else s)"
definition "SI s = (S s ∧ (∀x ∈ set_of s. I x))"
lemma SI_empty: "SI empty"
by(simp add: SI_def S_empty set_of_empty)
lemma SI_insert_mod:
"I x ⟹ SI s ⟹ SI (insert_mod x s)"
apply(simp add: SI_def S_insert_mod)
by (metis insertE set_of_insert_mod)
lemma SI_insert_mod2: "(⋀x. inv0 x ⟹ I (f x)) ⟹
inv0 x ⟹ SI s ⟹ SI (insert_mod2 P f x s)"
by (metis insert_mod2_def SI_insert_mod)
definition worklist_tree_coll_aux ::
"('b ⇒ 'b list) ⇒ ('b ⇒ bool) ⇒ ('b ⇒ 'a) ⇒ 'b list ⇒ 's ⇒ 's option"
where
"worklist_tree_coll_aux succs P f = worklist_tree succs (insert_mod2 P f)"
definition worklist_tree_coll ::
"('b ⇒ 'b list) ⇒ ('b ⇒ bool) ⇒ ('b ⇒ 'a) ⇒ 'b list ⇒ 's option"
where
"worklist_tree_coll succs P f ws = worklist_tree_coll_aux succs P f ws empty"
lemma worklist_tree_coll_aux_equiv:
assumes "worklist_tree_coll_aux succs P f ws s = Some s'"
and "invariant inv0 succs"
and "∀x ∈ set ws. inv0 x"
and "⋀x. inv0 x ⟹ I(f x)"
and "SI s"
shows "set_of s' =⇩≼
f ` {x : (Rel succs)⇧* `` (set ws). P x} ∪ set_of s"
apply(insert assms(1))
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and
P = "λws s s'. SI s ⟶ set_of s' =⇩≼ f ` {x : set ws. P x} ∪ set_of s",
OF _ assms(2,3,5)])
apply(simp add: SI_insert_mod2 assms(4))
apply(clarsimp)
apply(clarsimp simp add: insert_mod2_def split: if_split_asm)
apply(frule assms(4))
apply(frule SI_def[THEN iffD1])
apply(frule (1) set_of_insert_mod)
apply (simp add: SI_insert_mod)
apply(erule disjE)
prefer 2
apply(rule seteq_qle_trans)
apply assumption
apply (simp add: "defs")
apply blast
apply(rule seteq_qle_trans)
apply assumption
apply (simp add: "defs")
apply blast
apply(rule seteq_qle_trans)
apply assumption
apply (simp add: "defs")
apply blast
using assms(5)
apply auto
done
lemma worklist_tree_coll_equiv:
"worklist_tree_coll succs P f ws = Some s' ⟹ invariant inv0 succs
⟹ ∀x ∈ set ws. inv0 x ⟹ (⋀x. inv0 x ⟹ I(f x))
⟹ set_of s' =⇩≼ f ` {x : (Rel succs)⇧* `` (set ws). P x}"
unfolding worklist_tree_coll_def
apply(drule (2) worklist_tree_coll_aux_equiv)
apply(auto simp: set_of_empty SI_empty)
done
lemma worklist_tree_coll_aux_subseteq:
"worklist_tree_coll_aux succs P f ws t⇩0 = Some t ⟹
invariant inv0 succs ⟹ ∀g ∈ set ws. inv0 g ⟹
(⋀x. inv0 x ⟹ I(f x)) ⟹ SI t⇩0 ⟹
set_of t ⊆ set_of t⇩0 ∪ f ` {h : (Rel succs)⇧* `` set ws. P h}"
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and P =
"λws t t'. set_of t' ⊆ set_of t ∪ f ` {g ∈ set ws. P g}"])
apply assumption
apply assumption
apply assumption
apply(simp add: SI_insert_mod2)
apply clarsimp
apply (clarsimp simp: insert_mod2_def split: if_split_asm)
using set_of_insert_mod
apply(simp add: SI_def image_def)
apply(blast)
apply blast
apply blast
done
lemma worklist_tree_coll_subseteq:
"worklist_tree_coll succs P f ws = Some t ⟹
invariant inv0 succs ⟹ ∀g ∈ set ws. inv0 g ⟹
(⋀x. inv0 x ⟹ I(f x)) ⟹
set_of t ⊆ f ` {h : (Rel succs)⇧* `` set ws. P h}"
unfolding worklist_tree_coll_def
apply(drule (1) worklist_tree_coll_aux_subseteq)
apply(auto simp: set_of_empty SI_empty)
done
lemma worklist_tree_coll_inv:
"worklist_tree_coll succs P f ws = Some s ⟹ S s"
unfolding worklist_tree_coll_def worklist_tree_coll_aux_def
apply(drule worklist_tree_state_inv[where I = S])
apply (auto simp: S_empty insert_mod2_def S_insert_mod)
done
end
end
Theory Maps
theory Maps
imports Worklist Quasi_Order
begin
locale maps =
fixes empty :: "'m"
and up :: "'a ⇒ 'b list ⇒ 'm ⇒ 'm"
and map_of :: "'m ⇒ 'a ⇒ 'b list"
and M :: "'m ⇒ bool"
assumes map_empty: "map_of empty = (λa. [])"
and map_up: "map_of (up a b m) = (map_of m)(a := b)"
and M_empty: "M empty"
and M_up: "M m ⟹ M (up a b m)"
begin
definition "set_of m = (UN x. set(map_of m x))"
end
locale set_mod_maps = maps empty up map_of M + quasi_order qle
for empty :: "'m"
and up :: "'a ⇒ 'b list ⇒ 'm ⇒ 'm"
and map_of :: "'m ⇒ 'a ⇒ 'b list"
and M :: "'m ⇒ bool"
and qle :: "'b ⇒ 'b ⇒ bool" (infix "≼" 60)
+
fixes subsumed :: "'b ⇒ 'b ⇒ bool"
and I :: "'b ⇒ bool"
and key :: "'b ⇒ 'a"
assumes equiv_iff_qle: "I x ⟹ I y ⟹ subsumed x y = (x ≼ y)"
and "key=key"
begin
definition "insert_mod x m =
(let k = key x; ys = map_of m k
in if (∃y ∈ set ys. subsumed x y) then m else up k (x#ys) m)"
end
sublocale
set_mod_maps <
set_by_maps?: set_modulo qle empty insert_mod set_of I M
proof (standard, goal_cases)
case 1 show ?case by(simp add:set_of_def map_empty)
next
case 2 thus ?case
by (auto simp: Let_def insert_mod_def set_of_def map_up equiv_iff_qle
split:if_split_asm)
next
case 3 show ?case by(simp add: M_empty)
next
case 4 thus ?case
by(simp add: insert_mod_def Let_def M_up)
qed
end
Theory Arch
section ‹Archive›
theory Arch
imports Main "HOL-Library.Code_Target_Numeral"
begin
setup ‹fn thy =>
let
val T = @{typ "integer list list list"}
val dir = Resources.master_directory thy
in
thy |>
Code_Runtime.polyml_as_definition
[(@{binding Tri'}, T), (@{binding Quad'}, T), (@{binding Pent'}, T),
(@{binding Hex'}, T)]
(map (Path.append dir)
[\<^path>‹Archives/Tri.ML›, \<^path>‹Archives/Quad.ML›,
\<^path>‹Archives/Pent.ML›, \<^path>‹Archives/Hex.ML›])
end
›
text ‹The definition of these constants is only ever needed at the ML level
when running the eval proof method.›
definition Tri :: "nat list list list"
where
"Tri = (map ∘ map ∘ map) nat_of_integer Tri'"
definition Quad :: "nat list list list"
where
"Quad = (map ∘ map ∘ map) nat_of_integer Quad'"
definition Pent :: "nat list list list"
where
"Pent = (map ∘ map ∘ map) nat_of_integer Pent'"
definition Hex :: "nat list list list"
where
"Hex = (map ∘ map ∘ map) nat_of_integer Hex'"
end
Theory ArchCompAux
section ‹Comparing Enumeration and Archive›
theory ArchCompAux
imports TameEnum Trie.Tries Maps Arch Worklist
begin
function qsort :: "('a ⇒ 'a ⇒ bool) ⇒ 'a list ⇒ 'a list" where
"qsort le [] = []" |
"qsort le (x#xs) = qsort le [y←xs . ¬ le x y] @ [x] @
qsort le [y←xs . le x y]"
by pat_completeness auto
termination by (relation "measure (size ∘ snd)")
(auto simp add: length_filter_le [THEN le_less_trans])
definition nof_vertices :: "'a fgraph ⇒ nat" where
"nof_vertices = length ∘ remdups ∘ concat"
definition fgraph :: "graph ⇒ nat fgraph" where
"fgraph g = map vertices (faces g)"
definition hash :: "nat fgraph ⇒ nat list" where
"hash fs = (let n = nof_vertices fs in
[n, size fs] @
qsort (λx y. y < x) (map (λi. foldl (+) 0 (map size [f←fs. i ∈ set f]))
[0..<n]))"
definition samet :: "(nat,nat fgraph) tries option ⇒ nat fgraph list ⇒ bool"
where
"samet fgto ags = (case fgto of None ⇒ False | Some tfgs ⇒
let tags = tries_of_list hash ags in
(all_tries (λfg. list_ex (iso_test fg) (lookup_tries tags (hash fg))) tfgs ∧
all_tries (λag. list_ex (iso_test ag) (lookup_tries tfgs (hash ag))) tags))"
definition pre_iso_test :: "vertex fgraph ⇒ bool" where
"pre_iso_test Fs ⟷
[] ∉ set Fs ∧ (∀F∈set Fs. distinct F) ∧ distinct (map rotate_min Fs)"
interpretation map:
maps "Trie None []" update_trie lookup_tries invar_trie
proof (standard, goal_cases)
case 1 show ?case by(rule ext) simp
next
case 2 show ?case by(rule ext) (simp add: lookup_update)
next
case 3 show ?case by(simp)
next
case 4 thus ?case by (simp add: invar_trie_update)
qed
lemma set_of_conv: "set_tries = maps.set_of lookup_tries"
by(rule ext) (auto simp add: set_tries_def map.set_of_def)
end
Theory ArchCompProps
section "Completeness of Archive Test"
theory ArchCompProps
imports TameEnumProps ArchCompAux
begin
lemma mgp_pre_iso_test: "minGraphProps g ⟹ pre_iso_test(fgraph g)"
apply(simp add:pre_iso_test_def fgraph_def image_def)
apply(rule conjI) apply(blast dest: mgp_vertices_nonempty[symmetric])
apply(rule conjI) apply(blast intro:minGraphProps)
apply(drule minGraphProps11)
apply(simp add:normFaces_def normFace_def verticesFrom_def minVertex_def
rotate_min_def o_def)
done
corollary iso_test_correct:
"⟦ pre_iso_test Fs⇩1; pre_iso_test Fs⇩2 ⟧ ⟹
iso_test Fs⇩1 Fs⇩2 = (Fs⇩1 ≃ Fs⇩2)"
by(simp add:pre_iso_test_def iso_correct inj_on_rotate_min_iff[symmetric]
distinct_map nof_vertices_def length_remdups_concat)
lemma trie_all_eq_set_of_trie:
"invar_trie t ⟹ all_trie (list_all P) t = (∀v ∈ set_tries t. P v)"
by(simp add: all_trie_eq_ran set_tries_eq_ran)
lemma samet_imp_iso_seteq:
assumes pre1: "⋀gs g. gsopt = Some gs ⟹ g ∈ set_tries gs ⟹ pre_iso_test g"
and pre2: "⋀g. g ∈ set arch ⟹ pre_iso_test g"
and inv: "⋀gs. gsopt = Some gs ⟹ invar_trie gs"
and same: "samet gsopt arch"
shows "∃gs. gsopt = Some gs ∧ set_tries gs =⇩≃ set arch"
proof -
obtain gs where [simp]: "gsopt = Some gs" and test1: "⋀g. g ∈ set_tries gs ⟹
∃h ∈ set arch. iso_test g h" and test2: "⋀g. g ∈ set arch ⟹
∃h ∈ set_tries gs. iso_test g h"
using same inv
by(force simp: samet_def trie_all_eq_set_of_trie invar_of_list all_tries_def
split:option.splits
dest: in_set_lookup_of_listD in_set_lookup_set_triesD)
have "set_tries gs ⊆⇩≃ set arch"
proof (auto simp:qle_gr.defs)
fix g assume g: "g ∈ set_tries gs"
obtain h where h: "h ∈ set arch" and test: "iso_test g h"
using test1[OF g] by blast
thus "∃h∈set arch. g ≃ h"
using h pre1[OF _ g] pre2[OF h] by (auto simp:iso_test_correct)
qed
moreover
have "set arch ⊆⇩≃ set_tries gs"
proof (auto simp:qle_gr.defs)
fix g assume g: "g ∈ set arch"
obtain h where h: "h ∈ set_tries gs" and test: "iso_test g h"
using test2[OF g] by blast
thus "∃h ∈ set_tries gs. g ≃ h"
using h pre1[OF _ h] pre2[OF g] by (auto simp:iso_test_correct)
qed
ultimately show ?thesis by (auto simp: qle_gr.seteq_qle_def)
qed
lemma samet_imp_iso_subseteq:
assumes pre1: "⋀gs g. gsopt = Some gs ⟹ g ∈ set_tries gs ⟹ pre_iso_test g"
and pre2: "⋀g. g ∈ set arch ⟹ pre_iso_test g"
and inv: "⋀gs. gsopt = Some gs ⟹ invar_trie gs"
and same: "samet gsopt arch"
shows "∃gs. gsopt = Some gs ∧ set_tries gs ⊆⇩≃ set arch"
using qle_gr.seteq_qle_def assms samet_imp_iso_seteq by metis
global_interpretation set_mod_trie:
set_mod_maps "Trie None []" update_trie lookup_tries invar_trie "(≃)" iso_test pre_iso_test hash
defines insert_mod_trie = "set_mod_maps.insert_mod update_trie lookup_tries iso_test hash"
and worklist_tree_coll_trie = "set_modulo.worklist_tree_coll (Trie None []) insert_mod_trie"
and worklist_tree_coll_aux_trie = "set_modulo.worklist_tree_coll_aux insert_mod_trie"
and insert_mod2_trie = "set_modulo.insert_mod2 insert_mod_trie"
by standard (simp_all add: iso_test_correct)
definition enum_filter_finals ::
"(graph ⇒ graph list) ⇒ graph list
⇒ (nat,nat fgraph) tries option" where
"enum_filter_finals succs = set_mod_trie.worklist_tree_coll succs final fgraph"
definition tameEnumFilter :: "nat ⇒ (nat,nat fgraph)tries option" where
"tameEnumFilter p = enum_filter_finals (next_tame p) [Seed p]"
lemma TameEnum_tameEnumFilter:
"tameEnumFilter p = Some t ⟹ set_tries t =⇩≃ fgraph ` TameEnum⇘p⇙"
apply(auto simp: tameEnumFilter_def TameEnumP_def enum_filter_finals_def)
apply(drule set_mod_trie.worklist_tree_coll_equiv[OF _ inv_inv_next_tame])
apply (auto simp: set_of_conv inv_Seed mgp_pre_iso_test RTranCl_conv)
done
lemma tameEnumFilter_subseteq_TameEnum:
"tameEnumFilter p = Some t ⟹ set_tries t ⊆ fgraph ` TameEnum⇘p⇙"
by(auto simp add:tameEnumFilter_def TameEnumP_def enum_filter_finals_def
set_of_conv inv_Seed mgp_pre_iso_test RTranCl_conv
dest!: set_mod_trie.worklist_tree_coll_subseteq[OF _ inv_inv_next_tame])
lemma inv_tries_tameEnumFilter:
"tameEnumFilter p = Some t ⟹ invar_trie t"
unfolding tameEnumFilter_def enum_filter_finals_def
by(erule set_mod_trie.worklist_tree_coll_inv)
theorem combine_evals_filter:
"∀g ∈ set arch. pre_iso_test g ⟹ samet (tameEnumFilter p) arch
⟹ fgraph ` TameEnum⇘p⇙ ⊆⇩≃ set arch"
apply(subgoal_tac "∃t. tameEnumFilter p = Some t ∧ set_tries t ⊆⇩≃ set arch")
apply(metis TameEnum_tameEnumFilter qle_gr.seteq_qle_def qle_gr.subseteq_qle_trans)
apply(fastforce intro!: samet_imp_iso_subseteq
dest: inv_tries_tameEnumFilter tameEnumFilter_subseteq_TameEnum mgp_TameEnum mgp_pre_iso_test)
done
end
Theory Relative_Completeness
section ‹Completeness Proofs under hypothetical computations›
theory Relative_Completeness
imports ArchCompProps
begin
definition Archive :: "vertex fgraph set" where
"Archive ≡ set(Tri @ Quad @ Pent @ Hex)"
locale archive_by_computation =
assumes pre_iso_test3: "∀g ∈ set Tri. pre_iso_test g"
assumes pre_iso_test4: "∀g ∈ set Quad. pre_iso_test g"
assumes pre_iso_test5: "∀g ∈ set Pent. pre_iso_test g"
assumes pre_iso_test6: "∀g ∈ set Hex. pre_iso_test g"
assumes same3: "samet (tameEnumFilter 0) Tri"
assumes same4: "samet (tameEnumFilter 1) Quad"
assumes same5: "samet (tameEnumFilter 2) Pent"
assumes same6: "samet (tameEnumFilter 3) Hex"
begin
theorem TameEnum_Archive: "fgraph ` TameEnum ⊆⇩≃ Archive"
using combine_evals_filter[OF pre_iso_test3 same3]
combine_evals_filter[OF pre_iso_test4 same4]
combine_evals_filter[OF pre_iso_test5 same5]
combine_evals_filter[OF pre_iso_test6 same6]
by(fastforce simp:TameEnum_def Archive_def image_def qle_gr.defs
eval_nat_numeral le_Suc_eq)
lemma TameEnum_comp:
assumes "Seed⇘p⇙ [next_plane⇘p⇙]→* g" and "final g" and "tame g"
shows "Seed⇘p⇙ [next_tame⇘p⇙]→* g"
proof -
from assms have "Seed⇘p⇙ [next_tame0 p]→* g" by(rule next_tame0_comp)
with assms show "Seed⇘p⇙ [next_tame⇘p⇙]→* g" by(blast intro: next_tame_comp)
qed
lemma tame5:
assumes g: "Seed⇘p⇙ [next_plane0⇘p⇙]→* g" and "final g" and "tame g"
shows "p ≤ 3"
proof -
from ‹tame g› have bound: "∀f ∈ ℱ g. |vertices f| ≤ 6"
by (simp add: tame_def tame9a_def)
show "p ≤ 3"
proof (rule ccontr)
assume 6: "¬ p ≤ 3"
obtain f where "f ∈ set (finals g) ∧ |vertices f| = p+3"
using max_face_ex[OF g] by auto
also from ‹final g› have "set (finals g) = set (faces g)" by simp
finally have "f ∈ ℱ g ∧ 6 < |vertices f|" using 6 by arith
with bound show False by auto
qed
qed
theorem completeness:
assumes "g ∈ PlaneGraphs" and "tame g" shows "fgraph g ∈⇩≃ Archive"
proof -
from ‹g ∈ PlaneGraphs› obtain p where g1: "Seed⇘p⇙ [next_plane⇘p⇙]→* g"
and "final g"
by(auto simp:PlaneGraphs_def PlaneGraphsP_def)
have "Seed⇘p⇙ [next_plane0⇘p⇙]→* g"
by(rule RTranCl_subset2[OF g1])
(blast intro:inv_mgp inv_Seed mgp_next_plane0_if_next_plane
dest:RTranCl_inv[OF inv_inv_next_plane])
with ‹tame g› ‹final g› have "p ≤ 3" by(blast intro:tame5)
with g1 ‹tame g› ‹final g› show ?thesis using TameEnum_Archive
by(simp add: qle_gr.defs TameEnum_def TameEnumP_def)
(blast intro: TameEnum_comp)
qed
end
end